Artifact 4aa4852a388aeebee8735ba7db8538e79db73b04:
- File
kitsh/buildsrc/kitsh-0.0/mk4tcl.tcl
— part of check-in
[66930bd6ef]
at
2010-09-26 04:42:08
on branch trunk
— Added support for minimal builds
Fixed potential loading issue for zlib in pure Tcl metakit (user: rkeene, size: 17871) [annotate] [blame] [check-ins using]
0000: 23 21 20 2f 75 73 72 2f 62 69 6e 2f 65 6e 76 20 #! /usr/bin/env
0010: 74 63 6c 73 68 0a 23 20 52 65 61 64 4b 69 74 2c tclsh.# ReadKit,
0020: 20 61 20 76 69 65 77 65 72 2f 65 78 74 72 61 63 a viewer/extrac
0030: 74 6f 72 2f 63 6f 6e 76 65 72 74 65 72 20 66 6f tor/converter fo
0040: 72 20 73 74 61 72 6b 69 74 73 20 77 68 69 63 68 r starkits which
0050: 20 64 6f 65 73 20 6e 6f 74 0a 23 20 72 65 71 75 does not.# requ
0060: 69 72 65 20 54 63 6c 4b 69 74 20 6f 72 20 4d 65 ire TclKit or Me
0070: 74 61 4b 69 74 2e 20 20 54 68 69 73 20 66 69 6c taKit. This fil
0080: 65 20 77 61 73 20 67 65 6e 65 72 61 74 65 64 20 e was generated
0090: 62 79 20 22 72 6b 67 65 6e 2e 74 63 6c 22 2e 0a by "rkgen.tcl"..
00a0: 23 0a 23 20 4a 75 6e 65 20 32 30 30 32 2c 20 4a #.# June 2002, J
00b0: 65 61 6e 2d 43 6c 61 75 64 65 20 57 69 70 70 6c ean-Claude Wippl
00c0: 65 72 20 3c 6a 63 77 40 65 71 75 69 34 2e 63 6f er <jcw@equi4.co
00d0: 6d 3e 0a 0a 23 20 74 68 69 73 20 69 73 20 6e 65 m>..# this is ne
00e0: 65 64 65 64 20 73 6f 20 6f 66 74 65 6e 20 74 68 eded so often th
00f0: 61 74 20 49 20 6a 75 73 74 20 64 72 6f 70 20 63 at I just drop c
0100: 6f 70 69 65 73 20 6f 66 20 69 74 20 61 6c 6c 20 opies of it all
0110: 6f 76 65 72 20 74 68 65 20 70 6c 61 63 65 0a 69 over the place.i
0120: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
0130: 20 61 75 74 6f 5f 69 6e 64 65 78 28 6c 61 73 73 auto_index(lass
0140: 69 67 6e 29 5d 20 26 26 20 5b 69 6e 66 6f 20 63 ign)] && [info c
0150: 6f 6d 6d 61 6e 64 73 20 6c 61 73 73 69 67 6e 5d ommands lassign]
0160: 20 3d 3d 20 22 22 7d 20 7b 0a 20 20 70 72 6f 63 == ""} {. proc
0170: 20 6c 61 73 73 69 67 6e 20 7b 6c 20 61 72 67 73 lassign {l args
0180: 7d 20 7b 0a 20 20 20 20 66 6f 72 65 61 63 68 20 } {. foreach
0190: 76 20 24 6c 20 61 20 24 61 72 67 73 20 7b 20 75 v $l a $args { u
01a0: 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 73 plevel 1 [list s
01b0: 65 74 20 24 61 20 24 76 5d 20 7d 0a 20 20 7d 0a et $a $v] }. }.
01c0: 7d 0a 0a 63 61 74 63 68 20 7b 0a 09 6c 6f 61 64 }..catch {..load
01d0: 20 7b 7d 20 7a 6c 69 62 0a 7d 0a 63 61 74 63 68 {} zlib.}.catch
01e0: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
01f0: 69 72 65 20 7a 6c 69 62 0a 7d 0a 0a 69 66 20 7b ire zlib.}..if {
0200: 5b 69 6e 66 6f 20 63 6f 6d 6d 20 6d 6d 61 70 5d [info comm mmap]
0210: 20 3d 3d 20 22 22 7d 20 7b 0a 20 20 20 20 23 20 == ""} {. #
0220: 6d 6d 61 70 20 61 6e 64 20 6d 76 65 63 20 70 72 mmap and mvec pr
0230: 69 6d 69 74 69 76 65 73 20 69 6e 20 70 75 72 65 imitives in pure
0240: 20 54 63 6c 20 28 61 20 43 20 76 65 72 73 69 6f Tcl (a C versio
0250: 6e 20 69 73 20 70 72 65 73 65 6e 74 20 69 6e 20 n is present in
0260: 63 72 69 74 6c 69 62 29 0a 0a 20 20 20 20 6e 61 critlib).. na
0270: 6d 65 73 70 61 63 65 20 65 78 70 6f 72 74 20 6d mespace export m
0280: 6d 61 70 20 6d 76 65 63 0a 0a 20 20 20 20 6e 61 map mvec.. na
0290: 6d 65 73 70 61 63 65 20 65 76 61 6c 20 76 20 7b mespace eval v {
02a0: 0a 09 61 72 72 61 79 20 73 65 74 20 6d 6d 61 70 ..array set mmap
02b0: 5f 64 61 74 61 20 7b 7d 0a 09 61 72 72 61 79 20 _data {}..array
02c0: 73 65 74 20 6d 76 65 63 5f 73 68 69 66 74 73 20 set mvec_shifts
02d0: 7b 0a 20 20 20 20 2d 20 2d 31 20 20 20 20 30 20 {. - -1 0
02e0: 2d 31 0a 20 20 20 20 31 20 20 30 20 20 20 20 32 -1. 1 0 2
02f0: 20 20 31 20 20 20 20 34 20 20 32 20 20 20 20 38 1 4 2 8
0300: 20 20 20 33 0a 20 20 20 20 31 36 20 34 20 20 20 3. 16 4
0310: 31 36 72 20 34 0a 20 20 20 20 33 32 20 35 20 20 16r 4. 32 5
0320: 20 33 32 72 20 35 20 20 20 33 32 66 20 35 20 20 32r 5 32f 5
0330: 20 33 32 66 72 20 35 0a 20 20 20 20 36 34 20 36 32fr 5. 64 6
0340: 20 20 20 36 34 72 20 36 20 20 20 36 34 66 20 36 64r 6 64f 6
0350: 20 20 20 36 34 66 72 20 36 20 7d 0a 20 20 20 20 64fr 6 }.
0360: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6d 61 70 }.. proc mmap
0370: 20 7b 66 64 20 61 72 67 73 7d 20 7b 0a 09 75 70 {fd args} {..up
0380: 76 61 72 20 23 30 20 76 3a 3a 6d 6d 61 70 5f 64 var #0 v::mmap_d
0390: 61 74 61 28 24 66 64 29 20 64 61 74 61 0a 09 23 ata($fd) data..#
03a0: 20 73 70 65 63 69 61 6c 20 63 61 73 65 20 69 66 special case if
03b0: 20 66 64 20 69 73 20 74 68 65 20 6e 61 6d 65 20 fd is the name
03c0: 6f 66 20 61 20 76 61 72 69 61 62 6c 65 20 28 71 of a variable (q
03d0: 75 61 6c 69 66 69 65 64 20 6f 72 20 67 6c 6f 62 ualified or glob
03e0: 61 6c 29 0a 09 69 66 20 7b 5b 75 70 6c 65 76 65 al)..if {[upleve
03f0: 6c 20 23 30 20 5b 6c 69 73 74 20 69 6e 66 6f 20 l #0 [list info
0400: 65 78 69 73 74 73 20 24 66 64 5d 5d 7d 20 7b 0a exists $fd]]} {.
0410: 09 20 20 20 20 75 70 76 61 72 20 23 30 20 24 66 . upvar #0 $f
0420: 64 20 76 61 72 0a 09 20 20 20 20 73 65 74 20 64 d var.. set d
0430: 61 74 61 20 24 76 61 72 0a 09 7d 0a 09 23 20 63 ata $var..}..# c
0440: 61 63 68 65 20 61 20 66 75 6c 6c 20 63 6f 70 79 ache a full copy
0450: 20 6f 66 20 74 68 65 20 66 69 6c 65 20 74 6f 20 of the file to
0460: 73 69 6d 75 6c 61 74 65 20 6d 65 6d 6f 72 79 20 simulate memory
0470: 6d 61 70 70 69 6e 67 0a 09 69 66 20 7b 21 5b 69 mapping..if {![i
0480: 6e 66 6f 20 65 78 69 73 74 73 20 64 61 74 61 5d nfo exists data]
0490: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 70 6f 73 } {.. set pos
04a0: 20 5b 74 65 6c 6c 20 24 66 64 5d 0a 09 20 20 20 [tell $fd]..
04b0: 20 73 65 65 6b 20 24 66 64 20 30 20 65 6e 64 0a seek $fd 0 end.
04c0: 09 20 20 20 20 73 65 74 20 65 6e 64 20 5b 74 65 . set end [te
04d0: 6c 6c 20 24 66 64 5d 0a 09 20 20 20 20 73 65 65 ll $fd].. see
04e0: 6b 20 24 66 64 20 30 0a 09 20 20 20 20 73 65 74 k $fd 0.. set
04f0: 20 74 72 61 6e 73 20 5b 66 63 6f 6e 66 69 67 75 trans [fconfigu
0500: 72 65 20 24 66 64 20 2d 74 72 61 6e 73 6c 61 74 re $fd -translat
0510: 69 6f 6e 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 ion].. fconfi
0520: 67 75 72 65 20 24 66 64 20 2d 74 72 61 6e 73 6c gure $fd -transl
0530: 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a 09 20 20 ation binary..
0540: 20 20 73 65 74 20 64 61 74 61 20 5b 72 65 61 64 set data [read
0550: 20 24 66 64 20 24 65 6e 64 5d 0a 09 20 20 20 20 $fd $end]..
0560: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 64 20 2d fconfigure $fd -
0570: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 24 74 72 61 translation $tra
0580: 6e 73 0a 09 20 20 20 20 73 65 65 6b 20 24 66 64 ns.. seek $fd
0590: 20 24 70 6f 73 0a 09 7d 0a 09 73 65 74 20 74 6f $pos..}..set to
05a0: 74 61 6c 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 tal [string leng
05b0: 74 68 20 24 64 61 74 61 5d 0a 09 69 66 20 7b 5b th $data]..if {[
05c0: 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 3d llength $args] =
05d0: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 = 0} {.. retu
05e0: 72 6e 20 24 74 6f 74 61 6c 0a 09 7d 0a 09 66 6f rn $total..}..fo
05f0: 72 65 61 63 68 20 7b 6f 66 66 20 6c 65 6e 7d 20 reach {off len}
0600: 24 61 72 67 73 20 62 72 65 61 6b 0a 09 69 66 20 $args break..if
0610: 7b 24 6c 65 6e 20 3c 20 30 7d 20 7b 0a 09 20 20 {$len < 0} {..
0620: 20 20 73 65 74 20 6c 65 6e 20 24 74 6f 74 61 6c set len $total
0630: 0a 09 7d 0a 09 69 66 20 7b 24 6c 65 6e 20 3c 20 ..}..if {$len <
0640: 30 20 7c 7c 20 24 6c 65 6e 20 3e 20 24 74 6f 74 0 || $len > $tot
0650: 61 6c 20 2d 20 24 6f 66 66 7d 20 7b 0a 09 20 20 al - $off} {..
0660: 20 20 73 65 74 20 6c 65 6e 20 5b 65 78 70 72 20 set len [expr
0670: 7b 24 74 6f 74 61 6c 20 2d 20 24 6f 66 66 7d 5d {$total - $off}]
0680: 0a 09 7d 0a 09 62 69 6e 61 72 79 20 73 63 61 6e ..}..binary scan
0690: 20 24 64 61 74 61 20 40 24 7b 6f 66 66 7d 61 24 $data @${off}a$
06a0: 6c 65 6e 20 73 0a 09 72 65 74 75 72 6e 20 24 73 len s..return $s
06b0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 . }.. proc
06c0: 20 6d 76 65 63 20 7b 76 20 61 72 67 73 7d 20 7b mvec {v args} {
06d0: 0a 09 66 6f 72 65 61 63 68 20 7b 6d 6f 64 65 20 ..foreach {mode
06e0: 64 61 74 61 20 6f 66 66 20 6c 65 6e 7d 20 24 76 data off len} $v
06f0: 20 62 72 65 61 6b 0a 09 69 66 20 7b 5b 69 6e 66 break..if {[inf
0700: 6f 20 65 78 69 73 74 73 20 76 3a 3a 6d 76 65 63 o exists v::mvec
0710: 5f 73 68 69 66 74 73 28 24 6d 6f 64 65 29 5d 7d _shifts($mode)]}
0720: 20 7b 0a 09 20 20 20 20 23 20 75 73 65 20 5f 6d {.. # use _m
0730: 76 65 63 5f 67 65 74 20 74 6f 20 61 63 63 65 73 vec_get to acces
0740: 73 20 65 6c 65 6d 65 6e 74 73 0a 09 20 20 20 20 s elements..
0750: 73 65 74 20 73 68 69 66 74 20 24 76 3a 3a 6d 76 set shift $v::mv
0760: 65 63 5f 73 68 69 66 74 73 28 24 6d 6f 64 65 29 ec_shifts($mode)
0770: 0a 09 20 20 20 20 69 66 20 7b 5b 6c 6c 65 6e 67 .. if {[lleng
0780: 74 68 20 24 76 5d 20 3c 20 34 7d 20 7b 0a 09 09 th $v] < 4} {...
0790: 73 65 74 20 6c 65 6e 20 24 6f 66 66 0a 09 20 20 set len $off..
07a0: 20 20 7d 0a 09 20 20 20 20 73 65 74 20 67 65 74 }.. set get
07b0: 20 5b 6c 69 73 74 20 5f 6d 76 65 63 5f 67 65 74 [list _mvec_get
07c0: 20 24 73 68 69 66 74 20 24 76 20 2a 5d 0a 09 7d $shift $v *]..}
07d0: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 23 20 76 else {.. # v
07e0: 69 72 74 75 61 6c 20 6d 6f 64 65 2c 20 73 65 74 irtual mode, set
07f0: 20 74 6f 20 65 76 61 6c 75 61 74 65 20 73 63 72 to evaluate scr
0800: 69 70 74 0a 09 20 20 20 20 73 65 74 20 73 68 69 ipt.. set shi
0810: 66 74 20 22 22 0a 09 20 20 20 20 73 65 74 20 6c ft "".. set l
0820: 65 6e 20 5b 6c 69 6e 64 65 78 20 24 76 20 65 6e en [lindex $v en
0830: 64 5d 0a 09 20 20 20 20 73 65 74 20 67 65 74 20 d].. set get
0840: 24 76 0a 09 7d 0a 09 23 20 74 72 79 20 74 6f 20 $v..}..# try to
0850: 64 65 72 69 76 65 20 76 65 63 74 6f 72 20 6c 65 derive vector le
0860: 6e 67 74 68 20 66 72 6f 6d 20 64 61 74 61 20 6c ngth from data l
0870: 65 6e 67 74 68 20 69 66 20 6e 6f 74 20 73 70 65 ength if not spe
0880: 63 69 66 69 65 64 0a 09 69 66 20 7b 24 6c 65 6e cified..if {$len
0890: 20 3d 3d 20 22 22 20 7c 7c 20 24 6c 65 6e 20 3c == "" || $len <
08a0: 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 0} {.. set l
08b0: 65 6e 20 30 0a 09 20 20 20 20 69 66 20 7b 24 73 en 0.. if {$s
08c0: 68 69 66 74 20 3e 3d 20 30 7d 20 7b 0a 09 09 69 hift >= 0} {...i
08d0: 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 76 5d 20 f {[llength $v]
08e0: 3c 20 34 7d 20 7b 0a 09 09 20 20 20 20 73 65 74 < 4} {... set
08f0: 20 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 n [string lengt
0900: 68 20 24 64 61 74 61 5d 0a 09 09 7d 20 65 6c 73 h $data]...} els
0910: 65 20 7b 0a 09 09 20 20 20 20 73 65 74 20 6e 20 e {... set n
0920: 5b 6d 6d 61 70 20 24 64 61 74 61 5d 0a 09 09 7d [mmap $data]...}
0930: 0a 09 09 73 65 74 20 6c 65 6e 20 5b 65 78 70 72 ...set len [expr
0940: 20 7b 28 24 6e 20 3c 3c 20 33 29 20 3e 3e 20 24 {($n << 3) >> $
0950: 73 68 69 66 74 7d 5d 0a 09 20 20 20 20 7d 0a 09 shift}].. }..
0960: 7d 0a 09 73 65 74 20 6e 61 72 67 73 20 5b 6c 6c }..set nargs [ll
0970: 65 6e 67 74 68 20 24 61 72 67 73 5d 0a 09 23 20 ength $args]..#
0980: 77 69 74 68 20 6a 75 73 74 20 61 20 76 61 72 6e with just a varn
0990: 61 6d 65 20 61 73 20 61 72 67 2c 20 72 65 74 75 ame as arg, retu
09a0: 72 6e 20 69 6e 66 6f 20 61 62 6f 75 74 20 74 68 rn info about th
09b0: 69 73 20 76 65 63 74 6f 72 0a 09 69 66 20 7b 24 is vector..if {$
09c0: 6e 61 72 67 73 20 3d 3d 20 30 7d 20 7b 0a 09 20 nargs == 0} {..
09d0: 20 20 20 69 66 20 7b 24 73 68 69 66 74 20 3d 3d if {$shift ==
09e0: 20 22 22 7d 20 7b 0a 09 09 72 65 74 75 72 6e 20 ""} {...return
09f0: 5b 6c 69 73 74 20 24 6c 65 6e 20 7b 7d 20 24 76 [list $len {} $v
0a00: 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 72 65 ].. }.. re
0a10: 74 75 72 6e 20 5b 6c 69 73 74 20 24 6c 65 6e 20 turn [list $len
0a20: 24 6d 6f 64 65 20 24 73 68 69 66 74 5d 0a 09 7d $mode $shift]..}
0a30: 0a 09 66 6f 72 65 61 63 68 20 7b 70 6f 73 20 63 ..foreach {pos c
0a40: 6f 75 6e 74 20 70 72 65 64 20 63 6f 6e 64 7d 20 ount pred cond}
0a50: 24 61 72 67 73 20 62 72 65 61 6b 0a 09 23 20 77 $args break..# w
0a60: 69 74 68 20 61 6e 20 69 6e 64 65 78 20 61 73 20 ith an index as
0a70: 73 65 63 6f 6e 64 20 61 72 67 2c 20 64 6f 20 61 second arg, do a
0a80: 20 73 69 6e 67 6c 65 20 61 63 63 65 73 73 20 61 single access a
0a90: 6e 64 20 72 65 74 75 72 6e 20 65 6c 65 6d 65 6e nd return elemen
0aa0: 74 0a 09 69 66 20 7b 24 6e 61 72 67 73 20 3d 3d t..if {$nargs ==
0ab0: 20 31 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 1} {.. retur
0ac0: 6e 20 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 72 n [uplevel 1 [lr
0ad0: 65 70 6c 61 63 65 20 24 67 65 74 20 65 6e 64 20 eplace $get end
0ae0: 65 6e 64 20 24 70 6f 73 5d 5d 0a 09 7d 0a 09 69 end $pos]]..}..i
0af0: 66 20 7b 24 63 6f 75 6e 74 20 3c 20 30 7d 20 7b f {$count < 0} {
0b00: 0a 09 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 .. set count
0b10: 24 6c 65 6e 0a 09 7d 0a 09 69 66 20 7b 24 63 6f $len..}..if {$co
0b20: 75 6e 74 20 3e 20 24 6c 65 6e 20 2d 20 24 70 6f unt > $len - $po
0b30: 73 20 26 26 20 24 73 68 69 66 74 20 21 3d 20 2d s && $shift != -
0b40: 31 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 63 6f 1} {.. set co
0b50: 75 6e 74 20 5b 65 78 70 72 20 7b 24 6c 65 6e 20 unt [expr {$len
0b60: 2d 20 24 70 6f 73 7d 5d 0a 09 7d 0a 09 69 66 20 - $pos}]..}..if
0b70: 7b 24 6e 61 72 67 73 20 3d 3d 20 34 7d 20 7b 0a {$nargs == 4} {.
0b80: 09 20 20 20 20 75 70 76 61 72 20 24 70 72 65 64 . upvar $pred
0b90: 20 78 0a 09 7d 0a 09 73 65 74 20 72 20 7b 7d 0a x..}..set r {}.
0ba0: 09 69 6e 63 72 20 63 6f 75 6e 74 20 24 70 6f 73 .incr count $pos
0bb0: 0a 09 23 20 6c 6f 6f 70 20 74 68 72 6f 75 67 68 ..# loop through
0bc0: 20 73 70 65 63 69 66 69 65 64 20 72 61 6e 67 65 specified range
0bd0: 20 74 6f 20 62 75 69 6c 64 20 72 65 73 75 6c 74 to build result
0be0: 20 76 65 63 74 6f 72 0a 09 23 20 77 69 74 68 20 vector..# with
0bf0: 66 6f 75 72 20 61 72 67 73 2c 20 75 73 65 64 20 four args, used
0c00: 74 68 61 74 20 61 73 20 70 72 65 64 69 63 61 74 that as predicat
0c10: 65 20 66 75 6e 63 74 69 6f 6e 20 74 6f 20 66 69 e function to fi
0c20: 6c 74 65 72 0a 09 23 20 77 69 74 68 20 66 69 76 lter..# with fiv
0c30: 65 20 61 72 67 73 2c 20 75 73 65 20 66 6f 75 72 e args, use four
0c40: 74 68 20 61 73 20 6c 6f 6f 70 20 76 61 72 20 61 th as loop var a
0c50: 6e 64 20 61 70 70 6c 79 20 66 69 66 74 68 20 61 nd apply fifth a
0c60: 73 20 63 6f 6e 64 69 74 69 6f 6e 0a 09 66 6f 72 s condition..for
0c70: 20 7b 73 65 74 20 78 20 24 70 6f 73 7d 20 7b 24 {set x $pos} {$
0c80: 78 20 3c 20 24 63 6f 75 6e 74 7d 20 7b 69 6e 63 x < $count} {inc
0c90: 72 20 78 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 r x} {.. set
0ca0: 79 20 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 72 y [uplevel 1 [lr
0cb0: 65 70 6c 61 63 65 20 24 67 65 74 20 65 6e 64 20 eplace $get end
0cc0: 65 6e 64 20 24 78 5d 5d 0a 09 20 20 20 20 73 77 end $x]].. sw
0cd0: 69 74 63 68 20 24 6e 61 72 67 73 20 7b 0a 09 09 itch $nargs {...
0ce0: 33 20 7b 0a 09 09 09 69 66 20 7b 21 5b 75 70 6c 3 {....if {![upl
0cf0: 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 24 70 72 evel 1 [list $pr
0d00: 65 64 20 24 76 20 24 78 20 24 79 5d 5d 7d 20 63 ed $v $x $y]]} c
0d10: 6f 6e 74 69 6e 75 65 0a 09 09 20 20 20 20 7d 0a ontinue... }.
0d20: 09 09 34 20 7b 0a 09 09 09 69 66 20 7b 21 5b 75 ..4 {....if {![u
0d30: 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 65 plevel 1 [list e
0d40: 78 70 72 20 24 63 6f 6e 64 5d 5d 7d 20 63 6f 6e xpr $cond]]} con
0d50: 74 69 6e 75 65 0a 09 09 20 20 20 20 7d 0a 09 20 tinue... }..
0d60: 20 20 20 7d 0a 09 20 20 20 20 6c 61 70 70 65 6e }.. lappen
0d70: 64 20 72 20 24 79 0a 09 7d 0a 09 72 65 74 75 72 d r $y..}..retur
0d80: 6e 20 24 72 0a 20 20 20 20 7d 0a 0a 20 20 20 20 n $r. }..
0d90: 70 72 6f 63 20 5f 6d 76 65 63 5f 67 65 74 20 7b proc _mvec_get {
0da0: 73 68 69 66 74 20 64 65 73 63 20 69 6e 64 65 78 shift desc index
0db0: 7d 20 7b 0a 09 66 6f 72 65 61 63 68 20 7b 6d 6f } {..foreach {mo
0dc0: 64 65 20 64 61 74 61 20 6f 66 66 20 6c 65 6e 7d de data off len}
0dd0: 20 24 64 65 73 63 20 62 72 65 61 6b 0a 09 73 77 $desc break..sw
0de0: 69 74 63 68 20 2d 2d 20 24 6d 6f 64 65 20 7b 0a itch -- $mode {.
0df0: 09 20 20 20 20 2d 20 7b 0a 09 09 20 20 20 20 72 . - {... r
0e00: 65 74 75 72 6e 20 24 69 6e 64 65 78 0a 09 09 7d eturn $index...}
0e10: 0a 09 20 20 20 20 30 20 7b 0a 09 09 20 20 20 20 .. 0 {...
0e20: 72 65 74 75 72 6e 20 24 64 61 74 61 0a 09 09 7d return $data...}
0e30: 0a 09 7d 0a 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 ..}..if {[llengt
0e40: 68 20 24 64 65 73 63 5d 20 3c 20 34 7d 20 7b 0a h $desc] < 4} {.
0e50: 09 20 20 20 20 73 65 74 20 6f 66 66 20 5b 65 78 . set off [ex
0e60: 70 72 20 7b 28 24 69 6e 64 65 78 20 3c 3c 20 24 pr {($index << $
0e70: 73 68 69 66 74 29 20 3e 3e 20 33 7d 5d 0a 09 7d shift) >> 3}]..}
0e80: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 23 20 64 else {.. # d
0e90: 6f 6e 27 74 20 6c 6f 61 64 20 6d 6f 72 65 20 74 on't load more t
0ea0: 68 61 6e 20 38 20 62 79 74 65 73 20 66 72 6f 6d han 8 bytes from
0eb0: 20 74 68 65 20 70 72 6f 70 65 72 20 6f 66 66 73 the proper offs
0ec0: 65 74 0a 09 20 20 20 20 69 6e 63 72 20 6f 66 66 et.. incr off
0ed0: 20 5b 65 78 70 72 20 7b 28 24 69 6e 64 65 78 20 [expr {($index
0ee0: 3c 3c 20 24 73 68 69 66 74 29 20 3e 3e 20 33 7d << $shift) >> 3}
0ef0: 5d 0a 09 20 20 20 20 73 65 74 20 64 61 74 61 20 ].. set data
0f00: 5b 6d 6d 61 70 20 24 64 61 74 61 20 24 6f 66 66 [mmap $data $off
0f10: 20 38 5d 0a 09 20 20 20 20 73 65 74 20 6f 66 66 8].. set off
0f20: 20 30 0a 09 7d 0a 09 73 77 69 74 63 68 20 2d 2d 0..}..switch --
0f30: 20 24 6d 6f 64 65 20 7b 0a 09 20 20 20 20 31 20 $mode {.. 1
0f40: 7b 0a 09 09 20 20 20 20 62 69 6e 61 72 79 20 73 {... binary s
0f50: 63 61 6e 20 24 64 61 74 61 20 40 24 7b 6f 66 66 can $data @${off
0f60: 7d 63 20 76 61 6c 75 65 0a 09 09 20 20 20 20 72 }c value... r
0f70: 65 74 75 72 6e 20 5b 65 78 70 72 20 7b 28 24 76 eturn [expr {($v
0f80: 61 6c 75 65 3e 3e 28 24 69 6e 64 65 78 26 37 29 alue>>($index&7)
0f90: 29 20 26 31 7d 5d 0a 09 09 7d 0a 09 20 20 20 20 ) &1}]...}..
0fa0: 32 20 7b 0a 09 09 20 20 20 20 62 69 6e 61 72 79 2 {... binary
0fb0: 20 73 63 61 6e 20 24 64 61 74 61 20 40 24 7b 6f scan $data @${o
0fc0: 66 66 7d 63 20 76 61 6c 75 65 0a 09 09 20 20 20 ff}c value...
0fd0: 20 72 65 74 75 72 6e 20 5b 65 78 70 72 20 7b 28 return [expr {(
0fe0: 24 76 61 6c 75 65 3e 3e 28 28 24 69 6e 64 65 78 $value>>(($index
0ff0: 26 33 29 20 3c 3c 31 29 29 20 26 33 7d 5d 0a 09 &3) <<1)) &3}]..
1000: 09 7d 0a 09 20 20 20 20 34 20 7b 0a 09 09 20 20 .}.. 4 {...
1010: 20 20 62 69 6e 61 72 79 20 73 63 61 6e 20 24 64 binary scan $d
1020: 61 74 61 20 40 24 7b 6f 66 66 7d 63 20 76 61 6c ata @${off}c val
1030: 75 65 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 ue... return
1040: 5b 65 78 70 72 20 7b 28 24 76 61 6c 75 65 3e 3e [expr {($value>>
1050: 28 28 24 69 6e 64 65 78 26 31 29 20 3c 3c 32 29 (($index&1) <<2)
1060: 29 20 26 31 35 7d 5d 0a 09 09 7d 0a 09 20 20 20 ) &15}]...}..
1070: 20 38 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 8 {... set w
1080: 20 31 0a 09 09 20 20 20 20 73 65 74 20 66 20 63 1... set f c
1090: 0a 09 09 7d 0a 09 20 20 20 20 31 36 20 7b 0a 09 ...}.. 16 {..
10a0: 09 20 20 20 20 73 65 74 20 77 20 32 0a 09 09 20 . set w 2...
10b0: 20 20 20 73 65 74 20 66 20 73 0a 09 09 7d 0a 09 set f s...}..
10c0: 20 20 20 20 31 36 72 20 7b 0a 09 09 20 20 20 20 16r {...
10d0: 73 65 74 20 77 20 32 0a 09 09 20 20 20 20 73 65 set w 2... se
10e0: 74 20 66 20 53 0a 09 09 7d 0a 09 20 20 20 20 33 t f S...}.. 3
10f0: 32 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20 2 {... set w
1100: 34 0a 09 09 20 20 20 20 73 65 74 20 66 20 69 0a 4... set f i.
1110: 09 09 7d 0a 09 20 20 20 20 33 32 72 20 7b 0a 09 ..}.. 32r {..
1120: 09 20 20 20 20 73 65 74 20 77 20 34 0a 09 09 20 . set w 4...
1130: 20 20 20 73 65 74 20 66 20 49 0a 09 09 7d 0a 09 set f I...}..
1140: 20 20 20 20 33 32 66 72 20 2d 0a 09 20 20 20 20 32fr -..
1150: 33 32 66 20 7b 0a 09 09 20 20 20 20 73 65 74 20 32f {... set
1160: 77 20 34 0a 09 09 20 20 20 20 73 65 74 20 66 20 w 4... set f
1170: 66 0a 09 09 7d 0a 09 20 20 20 20 36 34 20 2d 0a f...}.. 64 -.
1180: 09 20 20 20 20 36 34 72 20 7b 0a 09 09 20 20 20 . 64r {...
1190: 20 73 65 74 20 77 20 38 0a 09 09 20 20 20 20 73 set w 8... s
11a0: 65 74 20 66 20 69 32 0a 09 09 7d 0a 09 20 20 20 et f i2...}..
11b0: 20 36 34 66 72 20 2d 0a 09 20 20 20 20 36 34 66 64fr -.. 64f
11c0: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20 38 {... set w 8
11d0: 0a 09 09 20 20 20 20 73 65 74 20 66 20 64 0a 09 ... set f d..
11e0: 09 7d 0a 09 7d 0a 0a 09 62 69 6e 61 72 79 20 73 .}..}...binary s
11f0: 63 61 6e 20 24 64 61 74 61 20 40 24 6f 66 66 24 can $data @$off$
1200: 66 20 76 61 6c 75 65 0a 09 72 65 74 75 72 6e 20 f value..return
1210: 24 76 61 6c 75 65 0a 20 20 20 20 7d 0a 0a 20 20 $value. }..
1220: 20 20 23 20 76 69 6d 3a 20 66 74 3d 74 63 6c 0a # vim: ft=tcl.
1230: 0a 7d 0a 0a 69 66 20 7b 5b 69 6e 66 6f 20 63 6f .}..if {[info co
1240: 6d 6d 20 64 62 6f 70 65 6e 5d 20 3d 3d 20 22 22 mm dbopen] == ""
1250: 7d 20 7b 0a 20 20 20 20 23 20 44 65 63 6f 64 65 } {. # Decode
1260: 72 20 66 6f 72 20 4d 65 74 61 4b 69 74 20 64 61 r for MetaKit da
1270: 74 61 66 69 6c 65 73 20 69 6e 20 54 63 6c 0a 0a tafiles in Tcl..
1280: 20 20 20 20 23 20 72 65 71 75 69 72 65 73 20 6d # requires m
1290: 6d 61 70 2f 6d 76 65 63 20 70 72 69 6d 69 74 69 map/mvec primiti
12a0: 76 65 73 3a 0a 20 20 20 20 23 73 6f 75 72 63 65 ves:. #source
12b0: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 69 6e 66 [file join [inf
12c0: 6f 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 o dirname [info
12d0: 73 63 72 69 70 74 5d 5d 20 6d 76 70 72 69 6d 2e script]] mvprim.
12e0: 74 63 6c 5d 0a 0a 20 20 20 20 6e 61 6d 65 73 70 tcl].. namesp
12f0: 61 63 65 20 65 78 70 6f 72 74 20 64 62 6f 70 65 ace export dbope
1300: 6e 20 64 62 63 6c 6f 73 65 20 64 62 74 72 65 65 n dbclose dbtree
1310: 20 61 63 63 65 73 73 20 76 6e 61 6d 65 73 20 76 access vnames v
1320: 6c 65 6e 0a 0a 20 20 20 20 6e 61 6d 65 73 70 61 len.. namespa
1330: 63 65 20 65 76 61 6c 20 76 20 7b 0a 09 76 61 72 ce eval v {..var
1340: 69 61 62 6c 65 20 77 69 64 74 68 73 20 7b 0a 20 iable widths {.
1350: 20 20 20 7b 38 20 31 36 20 20 31 20 33 32 20 20 {8 16 1 32
1360: 32 20 20 34 7d 0a 20 20 20 20 7b 34 20 20 38 20 2 4}. {4 8
1370: 20 31 20 31 36 20 20 32 20 20 30 7d 0a 20 20 20 1 16 2 0}.
1380: 20 7b 32 20 20 34 20 20 38 20 20 31 20 20 30 20 {2 4 8 1 0
1390: 31 36 7d 0a 20 20 20 20 7b 32 20 20 34 20 20 30 16}. {2 4 0
13a0: 20 20 38 20 20 31 20 20 30 7d 0a 20 20 20 20 7b 8 1 0}. {
13b0: 31 20 20 32 20 20 34 20 20 30 20 20 38 20 20 30 1 2 4 0 8 0
13c0: 7d 0a 20 20 20 20 7b 31 20 20 32 20 20 34 20 20 }. {1 2 4
13d0: 30 20 20 30 20 20 38 7d 0a 20 20 20 20 7b 31 20 0 0 8}. {1
13e0: 20 32 20 20 30 20 20 34 20 20 30 20 20 30 7d 20 2 0 4 0 0}
13f0: 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f }. }.. pro
1400: 63 20 66 65 74 63 68 20 7b 66 69 6c 65 7d 20 7b c fetch {file} {
1410: 0a 09 69 66 20 7b 24 66 69 6c 65 20 3d 3d 20 22 ..if {$file == "
1420: 22 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 "} {.. error
1430: 22 74 65 6d 70 20 73 74 6f 72 61 67 65 73 20 6e "temp storages n
1440: 6f 74 20 73 75 70 70 6f 72 74 65 64 22 0a 09 7d ot supported"..}
1450: 0a 09 73 65 74 20 76 3a 3a 64 61 74 61 20 5b 6f ..set v::data [o
1460: 70 65 6e 20 24 66 69 6c 65 5d 0a 09 73 65 74 20 pen $file]..set
1470: 76 3a 3a 73 65 71 6e 20 30 0a 20 20 20 20 7d 0a v::seqn 0. }.
1480: 0a 20 20 20 20 70 72 6f 63 20 62 79 74 65 5f 73 . proc byte_s
1490: 65 67 20 7b 6f 66 66 20 6c 65 6e 7d 20 7b 0a 09 eg {off len} {..
14a0: 69 6e 63 72 20 6f 66 66 20 24 76 3a 3a 7a 65 72 incr off $v::zer
14b0: 6f 0a 09 72 65 74 75 72 6e 20 5b 6d 6d 61 70 20 o..return [mmap
14c0: 24 76 3a 3a 64 61 74 61 20 24 6f 66 66 20 24 6c $v::data $off $l
14d0: 65 6e 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 en]. }.. p
14e0: 72 6f 63 20 69 6e 74 5f 73 65 67 20 7b 6f 66 66 roc int_seg {off
14f0: 20 63 6e 74 7d 20 7b 0a 09 73 65 74 20 76 65 63 cnt} {..set vec
1500: 20 5b 6c 69 73 74 20 33 32 72 20 5b 62 79 74 65 [list 32r [byte
1510: 5f 73 65 67 20 24 6f 66 66 20 5b 65 78 70 72 20 _seg $off [expr
1520: 7b 34 2a 24 63 6e 74 7d 5d 5d 5d 0a 09 72 65 74 {4*$cnt}]]]..ret
1530: 75 72 6e 20 5b 6d 76 65 63 20 24 76 65 63 20 30 urn [mvec $vec 0
1540: 20 24 63 6e 74 5d 0a 20 20 20 20 7d 0a 0a 20 20 $cnt]. }..
1550: 20 20 70 72 6f 63 20 67 65 74 5f 73 20 7b 6c 65 proc get_s {le
1560: 6e 7d 20 7b 0a 09 73 65 74 20 73 20 5b 62 79 74 n} {..set s [byt
1570: 65 5f 73 65 67 20 24 76 3a 3a 63 75 72 72 20 24 e_seg $v::curr $
1580: 6c 65 6e 5d 0a 09 69 6e 63 72 20 76 3a 3a 63 75 len]..incr v::cu
1590: 72 72 20 24 6c 65 6e 0a 09 72 65 74 75 72 6e 20 rr $len..return
15a0: 24 73 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 $s. }.. pr
15b0: 6f 63 20 67 65 74 5f 76 20 7b 7d 20 7b 0a 09 73 oc get_v {} {..s
15c0: 65 74 20 76 20 30 0a 09 77 68 69 6c 65 20 31 20 et v 0..while 1
15d0: 7b 0a 09 20 20 20 20 73 65 74 20 63 68 61 72 20 {.. set char
15e0: 5b 6d 76 65 63 20 24 76 3a 3a 62 79 74 65 20 24 [mvec $v::byte $
15f0: 76 3a 3a 63 75 72 72 5d 0a 09 20 20 20 20 69 6e v::curr].. in
1600: 63 72 20 76 3a 3a 63 75 72 72 0a 09 20 20 20 20 cr v::curr..
1610: 73 65 74 20 76 20 5b 65 78 70 72 20 7b 24 76 2a set v [expr {$v*
1620: 31 32 38 2b 28 24 63 68 61 72 26 30 78 66 66 29 128+($char&0xff)
1630: 7d 5d 0a 09 20 20 20 20 69 66 20 7b 24 63 68 61 }].. if {$cha
1640: 72 20 3c 20 30 7d 20 7b 0a 09 09 72 65 74 75 72 r < 0} {...retur
1650: 6e 20 5b 69 6e 63 72 20 76 20 2d 31 32 38 5d 0a n [incr v -128].
1660: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
1670: 0a 20 20 20 20 70 72 6f 63 20 67 65 74 5f 70 20 . proc get_p
1680: 7b 72 6f 77 73 20 76 73 20 76 6f 7d 20 7b 0a 09 {rows vs vo} {..
1690: 75 70 76 61 72 20 24 76 73 20 73 69 7a 65 20 24 upvar $vs size $
16a0: 76 6f 20 6f 66 66 0a 09 73 65 74 20 6f 66 66 20 vo off..set off
16b0: 30 0a 09 69 66 20 7b 24 72 6f 77 73 20 3d 3d 20 0..if {$rows ==
16c0: 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 69 0} {.. set si
16d0: 7a 65 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 ze 0..} else {..
16e0: 20 20 20 20 73 65 74 20 73 69 7a 65 20 5b 67 65 set size [ge
16f0: 74 5f 76 5d 0a 09 20 20 20 20 69 66 20 7b 24 73 t_v].. if {$s
1700: 69 7a 65 20 3e 20 30 7d 20 7b 0a 09 09 73 65 74 ize > 0} {...set
1710: 20 6f 66 66 20 5b 67 65 74 5f 76 5d 0a 09 20 20 off [get_v]..
1720: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 }..}. }..
1730: 20 20 70 72 6f 63 20 68 65 61 64 65 72 20 7b 7b proc header {{
1740: 65 6e 64 20 22 22 7d 7d 20 7b 0a 09 73 65 74 20 end ""}} {..set
1750: 76 3a 3a 7a 65 72 6f 20 30 0a 09 69 66 20 7b 24 v::zero 0..if {$
1760: 65 6e 64 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 end == ""} {..
1770: 20 20 73 65 74 20 65 6e 64 20 5b 6d 6d 61 70 20 set end [mmap
1780: 24 76 3a 3a 64 61 74 61 5d 0a 09 7d 0a 09 73 65 $v::data]..}..se
1790: 74 20 76 3a 3a 62 79 74 65 20 5b 6c 69 73 74 20 t v::byte [list
17a0: 38 20 24 76 3a 3a 64 61 74 61 20 24 76 3a 3a 7a 8 $v::data $v::z
17b0: 65 72 6f 20 24 65 6e 64 5d 0a 09 6c 61 73 73 69 ero $end]..lassi
17c0: 67 6e 20 5b 69 6e 74 5f 73 65 67 20 5b 65 78 70 gn [int_seg [exp
17d0: 72 20 7b 24 65 6e 64 2d 31 36 7d 5d 20 34 5d 20 r {$end-16}] 4]
17e0: 74 31 20 74 32 20 74 33 20 74 34 0a 09 73 65 74 t1 t2 t3 t4..set
17f0: 20 76 3a 3a 7a 65 72 6f 20 5b 65 78 70 72 20 7b v::zero [expr {
1800: 24 65 6e 64 2d 24 74 32 2d 31 36 7d 5d 0a 09 69 $end-$t2-16}]..i
1810: 6e 63 72 20 65 6e 64 20 2d 24 76 3a 3a 7a 65 72 ncr end -$v::zer
1820: 6f 0a 09 73 65 74 20 76 3a 3a 62 79 74 65 20 5b o..set v::byte [
1830: 6c 69 73 74 20 38 20 24 76 3a 3a 64 61 74 61 20 list 8 $v::data
1840: 24 76 3a 3a 7a 65 72 6f 20 24 65 6e 64 5d 0a 09 $v::zero $end]..
1850: 6c 61 73 73 69 67 6e 20 5b 69 6e 74 5f 73 65 67 lassign [int_seg
1860: 20 30 20 32 5d 20 68 31 20 68 32 0a 09 6c 61 73 0 2] h1 h2..las
1870: 73 69 67 6e 20 5b 69 6e 74 5f 73 65 67 20 5b 65 sign [int_seg [e
1880: 78 70 72 20 7b 24 68 32 2d 38 7d 5d 20 32 5d 20 xpr {$h2-8}] 2]
1890: 65 31 20 65 32 0a 09 73 65 74 20 76 3a 3a 69 6e e1 e2..set v::in
18a0: 66 6f 28 6d 6b 65 6e 64 29 20 24 68 32 0a 09 73 fo(mkend) $h2..s
18b0: 65 74 20 76 3a 3a 69 6e 66 6f 28 6d 6b 74 6f 63 et v::info(mktoc
18c0: 29 20 24 65 32 0a 09 73 65 74 20 76 3a 3a 69 6e ) $e2..set v::in
18d0: 66 6f 28 6d 6b 6c 65 6e 29 20 5b 65 78 70 72 20 fo(mklen) [expr
18e0: 7b 24 65 31 20 26 20 30 78 66 66 66 66 66 66 7d {$e1 & 0xffffff}
18f0: 5d 0a 09 73 65 74 20 76 3a 3a 63 75 72 72 20 24 ]..set v::curr $
1900: 65 32 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 e2. }.. pr
1910: 6f 63 20 6c 61 79 6f 75 74 20 7b 66 6d 74 7d 20 oc layout {fmt}
1920: 7b 0a 09 72 65 67 73 75 62 20 2d 61 6c 6c 20 7b {..regsub -all {
1930: 20 7d 20 24 66 6d 74 20 22 22 20 66 6d 74 0a 09 } $fmt "" fmt..
1940: 72 65 67 73 75 62 20 2d 61 6c 6c 20 7b 28 5c 77 regsub -all {(\w
1950: 2b 29 5c 5b 7d 20 24 66 6d 74 20 22 7b 5c 5c 31 +)\[} $fmt "{\\1
1960: 20 7b 22 20 66 6d 74 0a 09 72 65 67 73 75 62 20 {" fmt..regsub
1970: 2d 61 6c 6c 20 7b 5c 5d 7d 20 24 66 6d 74 20 22 -all {\]} $fmt "
1980: 7d 7d 22 20 66 6d 74 0a 09 72 65 67 73 75 62 20 }}" fmt..regsub
1990: 2d 61 6c 6c 20 7b 2c 7d 20 24 66 6d 74 20 22 20 -all {,} $fmt "
19a0: 22 20 66 6d 74 0a 09 72 65 74 75 72 6e 20 24 66 " fmt..return $f
19b0: 6d 74 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 mt. }.. pr
19c0: 6f 63 20 64 65 73 63 70 61 72 73 65 20 7b 64 65 oc descparse {de
19d0: 73 63 7d 20 7b 0a 09 73 65 74 20 6e 61 6d 65 73 sc} {..set names
19e0: 20 7b 7d 0a 09 73 65 74 20 74 79 70 65 73 20 7b {}..set types {
19f0: 7d 0a 09 66 6f 72 65 61 63 68 20 78 20 24 64 65 }..foreach x $de
1a00: 73 63 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 6c sc {.. if {[l
1a10: 6c 65 6e 67 74 68 20 24 78 5d 20 3d 3d 20 31 7d length $x] == 1}
1a20: 20 7b 0a 09 09 6c 61 73 73 69 67 6e 20 5b 73 70 {...lassign [sp
1a30: 6c 69 74 20 24 78 20 3a 5d 20 6e 61 6d 65 20 74 lit $x :] name t
1a40: 79 70 65 0a 09 09 69 66 20 7b 24 74 79 70 65 20 ype...if {$type
1a50: 3d 3d 20 22 22 7d 20 7b 0a 09 09 20 20 20 20 73 == ""} {... s
1a60: 65 74 20 74 79 70 65 20 53 0a 09 09 7d 0a 09 20 et type S...}..
1a70: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 6c 61 } else {...la
1a80: 73 73 69 67 6e 20 24 78 20 6e 61 6d 65 20 74 79 ssign $x name ty
1a90: 70 65 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 6c pe.. }.. l
1aa0: 61 70 70 65 6e 64 20 6e 61 6d 65 73 20 24 6e 61 append names $na
1ab0: 6d 65 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 20 me.. lappend
1ac0: 74 79 70 65 73 20 24 74 79 70 65 0a 09 7d 0a 09 types $type..}..
1ad0: 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 6e 61 return [list $na
1ae0: 6d 65 73 20 24 74 79 70 65 73 5d 0a 20 20 20 20 mes $types].
1af0: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6e 75 6d 76 }.. proc numv
1b00: 65 63 20 7b 72 6f 77 73 20 74 79 70 65 7d 20 7b ec {rows type} {
1b10: 0a 09 67 65 74 5f 70 20 24 72 6f 77 73 20 73 69 ..get_p $rows si
1b20: 7a 65 20 6f 66 66 0a 09 69 66 20 7b 24 73 69 7a ze off..if {$siz
1b30: 65 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 72 e == 0} {.. r
1b40: 65 74 75 72 6e 20 7b 30 20 30 7d 0a 09 7d 0a 09 eturn {0 0}..}..
1b50: 73 65 74 20 77 20 5b 65 78 70 72 20 7b 69 6e 74 set w [expr {int
1b60: 28 28 24 73 69 7a 65 3c 3c 33 29 20 2f 24 72 6f (($size<<3) /$ro
1b70: 77 73 29 7d 5d 0a 09 69 66 20 7b 24 72 6f 77 73 ws)}]..if {$rows
1b80: 20 3c 3d 20 37 20 26 26 20 30 20 3c 20 24 73 69 <= 7 && 0 < $si
1b90: 7a 65 20 26 26 20 24 73 69 7a 65 20 3c 3d 20 36 ze && $size <= 6
1ba0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 77 20 5b } {.. set w [
1bb0: 6c 69 6e 64 65 78 20 5b 6c 69 6e 64 65 78 20 24 lindex [lindex $
1bc0: 76 3a 3a 77 69 64 74 68 73 20 5b 65 78 70 72 20 v::widths [expr
1bd0: 7b 24 72 6f 77 73 2d 31 7d 5d 5d 20 5b 65 78 70 {$rows-1}]] [exp
1be0: 72 20 7b 24 73 69 7a 65 2d 31 7d 5d 5d 0a 09 7d r {$size-1}]]..}
1bf0: 0a 09 69 66 20 7b 24 77 20 3d 3d 20 30 7d 20 7b ..if {$w == 0} {
1c00: 0a 09 20 20 20 20 65 72 72 6f 72 20 22 6e 75 6d .. error "num
1c10: 76 65 63 3f 22 0a 09 7d 0a 09 73 77 69 74 63 68 vec?"..}..switch
1c20: 20 24 74 79 70 65 5c 0a 09 20 20 20 20 20 20 46 $type\.. F
1c30: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20 33 {... set w 3
1c40: 32 66 0a 09 09 7d 5c 0a 09 20 20 20 20 20 20 44 2f...}\.. D
1c50: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20 36 {... set w 6
1c60: 34 66 0a 09 09 7d 0a 09 69 6e 63 72 20 6f 66 66 4f...}..incr off
1c70: 20 24 76 3a 3a 7a 65 72 6f 0a 09 72 65 74 75 72 $v::zero..retur
1c80: 6e 20 5b 6c 69 73 74 20 24 77 20 24 76 3a 3a 64 n [list $w $v::d
1c90: 61 74 61 20 24 6f 66 66 20 24 72 6f 77 73 5d 0a ata $off $rows].
1ca0: 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 }.. proc
1cb0: 6c 61 7a 79 5f 73 74 72 20 7b 73 65 6c 66 20 72 lazy_str {self r
1cc0: 6f 77 73 20 74 79 70 65 20 70 6f 73 20 73 69 7a ows type pos siz
1cd0: 65 73 20 6d 73 69 7a 65 20 6d 6f 66 66 20 69 6e es msize moff in
1ce0: 64 65 78 7d 20 7b 0a 09 73 65 74 20 73 6f 66 66 dex} {..set soff
1cf0: 20 7b 7d 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 {}..for {set i
1d00: 30 7d 20 7b 24 69 20 3c 20 24 72 6f 77 73 7d 20 0} {$i < $rows}
1d10: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 {incr i} {..
1d20: 73 65 74 20 6e 20 5b 6d 76 65 63 20 24 73 69 7a set n [mvec $siz
1d30: 65 73 20 24 69 5d 0a 09 20 20 20 20 6c 61 70 70 es $i].. lapp
1d40: 65 6e 64 20 73 6f 66 66 20 24 70 6f 73 0a 09 20 end soff $pos..
1d50: 20 20 20 69 6e 63 72 20 70 6f 73 20 24 6e 0a 09 incr pos $n..
1d60: 7d 0a 09 69 66 20 7b 24 6d 73 69 7a 65 20 3e 20 }..if {$msize >
1d70: 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 6c 0} {.. set sl
1d80: 65 6e 20 5b 6d 76 65 63 20 24 73 69 7a 65 73 20 en [mvec $sizes
1d90: 30 20 24 72 6f 77 73 5d 0a 09 20 20 20 20 73 65 0 $rows].. se
1da0: 74 20 76 3a 3a 63 75 72 72 20 24 6d 6f 66 66 0a t v::curr $moff.
1db0: 09 20 20 20 20 73 65 74 20 6c 69 6d 69 74 20 5b . set limit [
1dc0: 65 78 70 72 20 7b 24 6d 6f 66 66 2b 24 6d 73 69 expr {$moff+$msi
1dd0: 7a 65 7d 5d 0a 09 20 20 20 20 66 6f 72 20 7b 73 ze}].. for {s
1de0: 65 74 20 72 6f 77 20 30 7d 20 7b 24 76 3a 3a 63 et row 0} {$v::c
1df0: 75 72 72 20 3c 20 24 6c 69 6d 69 74 7d 20 7b 69 urr < $limit} {i
1e00: 6e 63 72 20 72 6f 77 7d 20 7b 0a 09 09 69 6e 63 ncr row} {...inc
1e10: 72 20 72 6f 77 20 5b 67 65 74 5f 76 5d 0a 09 09 r row [get_v]...
1e20: 67 65 74 5f 70 20 31 20 6d 73 20 6d 6f 0a 09 09 get_p 1 ms mo...
1e30: 73 65 74 20 73 6f 66 66 20 5b 6c 72 65 70 6c 61 set soff [lrepla
1e40: 63 65 20 24 73 6f 66 66 20 24 72 6f 77 20 24 72 ce $soff $row $r
1e50: 6f 77 20 24 6d 6f 5d 0a 09 09 73 65 74 20 73 6c ow $mo]...set sl
1e60: 65 6e 20 5b 6c 72 65 70 6c 61 63 65 20 24 73 6c en [lreplace $sl
1e70: 65 6e 20 24 72 6f 77 20 24 72 6f 77 20 24 6d 73 en $row $row $ms
1e80: 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 73 65 ].. }.. se
1e90: 74 20 73 69 7a 65 73 20 5b 6c 69 73 74 20 6c 69 t sizes [list li
1ea0: 6e 64 65 78 20 24 73 6c 65 6e 20 24 72 6f 77 73 ndex $slen $rows
1eb0: 5d 0a 09 7d 0a 09 69 66 20 7b 24 74 79 70 65 20 ]..}..if {$type
1ec0: 3d 3d 20 22 53 22 7d 20 7b 0a 09 20 20 20 20 73 == "S"} {.. s
1ed0: 65 74 20 61 64 6a 20 2d 31 0a 09 7d 20 65 6c 73 et adj -1..} els
1ee0: 65 20 7b 0a 09 20 20 20 20 73 65 74 20 61 64 6a e {.. set adj
1ef0: 20 30 0a 09 7d 0a 09 73 65 74 20 76 3a 3a 6e 6f 0..}..set v::no
1f00: 64 65 28 24 73 65 6c 66 29 20 5b 6c 69 73 74 20 de($self) [list
1f10: 67 65 74 5f 73 74 72 20 24 73 6f 66 66 20 24 73 get_str $soff $s
1f20: 69 7a 65 73 20 24 61 64 6a 20 24 72 6f 77 73 5d izes $adj $rows]
1f30: 0a 09 72 65 74 75 72 6e 20 5b 6d 76 65 63 20 24 ..return [mvec $
1f40: 76 3a 3a 6e 6f 64 65 28 24 73 65 6c 66 29 20 24 v::node($self) $
1f50: 69 6e 64 65 78 5d 0a 20 20 20 20 7d 0a 0a 20 20 index]. }..
1f60: 20 20 70 72 6f 63 20 67 65 74 5f 73 74 72 20 7b proc get_str {
1f70: 73 6f 66 66 20 73 69 7a 65 73 20 61 64 6a 20 69 soff sizes adj i
1f80: 6e 64 65 78 7d 20 7b 0a 09 73 65 74 20 6e 20 5b ndex} {..set n [
1f90: 6d 76 65 63 20 24 73 69 7a 65 73 20 24 69 6e 64 mvec $sizes $ind
1fa0: 65 78 5d 0a 09 72 65 74 75 72 6e 20 5b 62 79 74 ex]..return [byt
1fb0: 65 5f 73 65 67 20 5b 6c 69 6e 64 65 78 20 24 73 e_seg [lindex $s
1fc0: 6f 66 66 20 24 69 6e 64 65 78 5d 20 5b 69 6e 63 off $index] [inc
1fd0: 72 20 6e 20 24 61 64 6a 5d 5d 0a 20 20 20 20 7d r n $adj]]. }
1fe0: 0a 0a 20 20 20 20 70 72 6f 63 20 6c 61 7a 79 5f .. proc lazy_
1ff0: 73 75 62 20 7b 73 65 6c 66 20 64 65 73 63 20 73 sub {self desc s
2000: 69 7a 65 20 6f 66 66 20 72 6f 77 73 20 69 6e 64 ize off rows ind
2010: 65 78 7d 20 7b 0a 09 73 65 74 20 76 3a 3a 63 75 ex} {..set v::cu
2020: 72 72 20 24 6f 66 66 0a 09 6c 61 73 73 69 67 6e rr $off..lassign
2030: 20 5b 64 65 73 63 70 61 72 73 65 20 24 64 65 73 [descparse $des
2040: 63 5d 20 6e 61 6d 65 73 20 74 79 70 65 73 0a 09 c] names types..
2050: 73 65 74 20 73 75 62 73 20 7b 7d 0a 09 66 6f 72 set subs {}..for
2060: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
2070: 20 24 72 6f 77 73 7d 20 7b 69 6e 63 72 20 69 7d $rows} {incr i}
2080: 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 67 65 74 {.. if {[get
2090: 5f 76 5d 20 21 3d 20 30 7d 20 7b 0a 09 09 65 72 _v] != 0} {...er
20a0: 72 6f 72 20 22 6c 61 7a 79 5f 73 75 62 3f 22 0a ror "lazy_sub?".
20b0: 09 20 20 20 20 7d 0a 09 20 20 20 20 6c 61 70 70 . }.. lapp
20c0: 65 6e 64 20 73 75 62 73 20 5b 70 72 65 70 61 72 end subs [prepar
20d0: 65 20 24 74 79 70 65 73 5d 0a 09 7d 0a 09 73 65 e $types]..}..se
20e0: 74 20 76 3a 3a 6e 6f 64 65 28 24 73 65 6c 66 29 t v::node($self)
20f0: 20 5b 6c 69 73 74 20 67 65 74 5f 73 75 62 20 24 [list get_sub $
2100: 6e 61 6d 65 73 20 24 73 75 62 73 20 24 72 6f 77 names $subs $row
2110: 73 5d 0a 09 72 65 74 75 72 6e 20 5b 6d 76 65 63 s]..return [mvec
2120: 20 24 76 3a 3a 6e 6f 64 65 28 24 73 65 6c 66 29 $v::node($self)
2130: 20 24 69 6e 64 65 78 5d 0a 20 20 20 20 7d 0a 0a $index]. }..
2140: 23 70 72 6f 63 20 62 61 63 6b 74 72 61 63 65 20 #proc backtrace
2150: 7b 7b 6c 65 76 65 6c 5f 61 64 6a 20 30 7d 7d 20 {{level_adj 0}}
2160: 7b 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 20 {.#
2170: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 72 set r
2180: 65 74 20 5b 6c 69 73 74 5d 20 20 20 20 20 20 20 et [list]
2190: 20 20 20 0a 23 0a 23 20 20 20 20 20 20 20 20 20 .#.#
21a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
21b0: 65 74 20 6c 65 76 65 6c 20 5b 65 78 70 72 20 30 et level [expr 0
21c0: 20 2d 20 24 6c 65 76 65 6c 5f 61 64 6a 5d 0a 23 - $level_adj].#
21d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21e0: 20 20 20 20 20 20 20 20 66 6f 72 20 7b 73 65 74 for {set
21f0: 20 69 20 5b 65 78 70 72 20 5b 69 6e 66 6f 20 6c i [expr [info l
2200: 65 76 65 6c 5d 20 2d 20 24 6c 65 76 65 6c 5f 61 evel] - $level_a
2210: 64 6a 5d 7d 20 7b 24 69 20 3e 20 31 7d 20 7b 69 dj]} {$i > 1} {i
2220: 6e 63 72 20 69 20 2d 31 7d 20 7b 0a 23 20 20 20 ncr i -1} {.#
2230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2240: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 63 inc
2250: 72 20 6c 65 76 65 6c 20 2d 31 0a 23 20 20 20 20 r level -1.#
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2270: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
2280: 72 65 74 20 5b 6c 69 6e 73 65 72 74 20 24 72 65 ret [linsert $re
2290: 74 20 30 20 5b 6c 69 6e 64 65 78 20 5b 69 6e 66 t 0 [lindex [inf
22a0: 6f 20 6c 65 76 65 6c 20 24 6c 65 76 65 6c 5d 20 o level $level]
22b0: 30 5d 5d 0a 23 20 20 20 20 20 20 20 20 20 20 20 0]].#
22c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 23 }.#
22d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22e0: 20 20 20 20 20 20 20 20 73 65 74 20 72 65 74 20 set ret
22f0: 5b 6c 69 6e 73 65 72 74 20 24 72 65 74 20 30 20 [linsert $ret 0
2300: 47 4c 4f 42 41 4c 5d 0a 23 20 20 20 20 20 20 20 GLOBAL].#
2310: 20 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 20 .#
2320: 20 20 20 20 20 20 20 20 20 20 20 72 65 74 75 72 retur
2330: 6e 20 24 72 65 74 0a 23 7d 0a 0a 20 20 20 20 70 n $ret.#}.. p
2340: 72 6f 63 20 67 65 74 5f 73 75 62 20 7b 6e 61 6d roc get_sub {nam
2350: 65 73 20 73 75 62 73 20 69 6e 64 65 78 7d 20 7b es subs index} {
2360: 0a 23 70 75 74 73 20 73 74 64 65 72 72 20 22 44 .#puts stderr "D
2370: 45 42 55 47 3a 20 67 65 74 5f 73 75 62 3a 20 5b EBUG: get_sub: [
2380: 6c 69 73 74 20 24 6e 61 6d 65 73 20 24 73 75 62 list $names $sub
2390: 73 20 24 69 6e 64 65 78 5d 22 0a 23 70 75 74 73 s $index]".#puts
23a0: 20 22 62 61 63 6b 74 72 61 63 65 3a 20 5b 62 61 "backtrace: [ba
23b0: 63 6b 74 72 61 63 65 5d 22 0a 09 6c 61 73 73 69 cktrace]"..lassi
23c0: 67 6e 20 5b 6c 69 6e 64 65 78 20 24 73 75 62 73 gn [lindex $subs
23d0: 20 24 69 6e 64 65 78 5d 20 72 6f 77 73 20 68 61 $index] rows ha
23e0: 6e 64 6c 65 72 73 0a 09 72 65 74 75 72 6e 20 5b ndlers..return [
23f0: 6c 69 73 74 20 67 65 74 5f 76 69 65 77 20 24 6e list get_view $n
2400: 61 6d 65 73 20 24 72 6f 77 73 20 24 68 61 6e 64 ames $rows $hand
2410: 6c 65 72 73 20 24 72 6f 77 73 5d 0a 20 20 20 20 lers $rows].
2420: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 70 72 65 70 }.. proc prep
2430: 61 72 65 20 7b 74 79 70 65 73 7d 20 7b 0a 09 73 are {types} {..s
2440: 65 74 20 72 20 5b 67 65 74 5f 76 5d 0a 09 73 65 et r [get_v]..se
2450: 74 20 68 61 6e 64 6c 65 72 73 20 7b 7d 0a 09 66 t handlers {}..f
2460: 6f 72 65 61 63 68 20 78 20 24 74 79 70 65 73 20 oreach x $types
2470: 7b 0a 09 20 20 20 20 73 65 74 20 6e 20 5b 69 6e {.. set n [in
2480: 63 72 20 76 3a 3a 73 65 71 6e 5d 0a 09 20 20 20 cr v::seqn]..
2490: 20 6c 61 70 70 65 6e 64 20 68 61 6e 64 6c 65 72 lappend handler
24a0: 73 20 24 6e 0a 09 20 20 20 20 73 77 69 74 63 68 s $n.. switch
24b0: 20 24 78 20 7b 0a 09 09 49 20 2d 0a 09 09 4c 20 $x {...I -...L
24c0: 2d 0a 09 09 46 20 2d 0a 09 09 44 20 7b 0a 09 09 -...F -...D {...
24d0: 09 73 65 74 20 76 3a 3a 6e 6f 64 65 28 24 6e 29 .set v::node($n)
24e0: 20 5b 6e 75 6d 76 65 63 20 24 72 20 24 78 5d 0a [numvec $r $x].
24f0: 09 09 20 20 20 20 7d 0a 09 09 42 20 2d 0a 09 09 .. }...B -...
2500: 53 20 7b 0a 09 09 09 67 65 74 5f 70 20 24 72 20 S {....get_p $r
2510: 73 69 7a 65 20 6f 66 66 0a 09 09 09 73 65 74 20 size off....set
2520: 73 69 7a 65 73 20 7b 30 20 30 7d 0a 09 09 09 69 sizes {0 0}....i
2530: 66 20 7b 24 73 69 7a 65 20 3e 20 30 7d 20 7b 0a f {$size > 0} {.
2540: 09 09 09 20 20 20 20 73 65 74 20 73 69 7a 65 73 ... set sizes
2550: 20 5b 6e 75 6d 76 65 63 20 24 72 20 49 5d 0a 09 [numvec $r I]..
2560: 09 09 7d 0a 09 09 09 67 65 74 5f 70 20 24 72 20 ..}....get_p $r
2570: 6d 73 69 7a 65 20 6d 6f 66 66 0a 09 09 09 73 65 msize moff....se
2580: 74 20 76 3a 3a 6e 6f 64 65 28 24 6e 29 20 5b 6c t v::node($n) [l
2590: 69 73 74 20 6c 61 7a 79 5f 73 74 72 20 24 6e 20 ist lazy_str $n
25a0: 24 72 20 24 78 20 24 6f 66 66 20 24 73 69 7a 65 $r $x $off $size
25b0: 73 5c 0a 09 09 09 20 20 24 6d 73 69 7a 65 20 24 s\.... $msize $
25c0: 6d 6f 66 66 20 24 72 5d 0a 09 09 20 20 20 20 7d moff $r]... }
25d0: 0a 09 09 64 65 66 61 75 6c 74 20 7b 0a 09 09 09 ...default {....
25e0: 67 65 74 5f 70 20 24 72 20 73 69 7a 65 20 6f 66 get_p $r size of
25f0: 66 0a 09 09 09 73 65 74 20 76 3a 3a 6e 6f 64 65 f....set v::node
2600: 28 24 6e 29 20 5b 6c 69 73 74 20 6c 61 7a 79 5f ($n) [list lazy_
2610: 73 75 62 20 24 6e 20 24 78 20 24 73 69 7a 65 20 sub $n $x $size
2620: 24 6f 66 66 20 24 72 20 24 72 5d 0a 09 09 20 20 $off $r $r]...
2630: 20 20 7d 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 72 }.. }..}..r
2640: 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 72 20 24 eturn [list $r $
2650: 68 61 6e 64 6c 65 72 73 5d 0a 20 20 20 20 7d 0a handlers]. }.
2660: 0a 20 20 20 20 70 72 6f 63 20 67 65 74 5f 76 69 . proc get_vi
2670: 65 77 20 7b 6e 61 6d 65 73 20 72 6f 77 73 20 68 ew {names rows h
2680: 61 6e 64 6c 65 72 73 20 69 6e 64 65 78 7d 20 7b andlers index} {
2690: 0a 09 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 67 ..return [list g
26a0: 65 74 5f 70 72 6f 70 20 24 6e 61 6d 65 73 20 24 et_prop $names $
26b0: 72 6f 77 73 20 24 68 61 6e 64 6c 65 72 73 20 24 rows $handlers $
26c0: 69 6e 64 65 78 20 5b 6c 6c 65 6e 67 74 68 20 24 index [llength $
26d0: 6e 61 6d 65 73 5d 5d 0a 20 20 20 20 7d 0a 0a 20 names]]. }..
26e0: 20 20 20 70 72 6f 63 20 67 65 74 5f 70 72 6f 70 proc get_prop
26f0: 20 7b 6e 61 6d 65 73 20 72 6f 77 73 20 68 61 6e {names rows han
2700: 64 6c 65 72 73 20 69 6e 64 65 78 20 69 64 65 6e dlers index iden
2710: 74 7d 20 7b 0a 09 73 65 74 20 63 6f 6c 20 5b 6c t} {..set col [l
2720: 73 65 61 72 63 68 20 2d 65 78 61 63 74 20 24 6e search -exact $n
2730: 61 6d 65 73 20 24 69 64 65 6e 74 5d 0a 09 69 66 ames $ident]..if
2740: 20 7b 24 63 6f 6c 20 3c 20 30 7d 20 7b 0a 09 20 {$col < 0} {..
2750: 20 20 20 65 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 error "unknow
2760: 6e 20 70 72 6f 70 65 72 74 79 3a 20 24 69 64 65 n property: $ide
2770: 6e 74 22 0a 09 7d 0a 09 73 65 74 20 68 20 5b 6c nt"..}..set h [l
2780: 69 6e 64 65 78 20 24 68 61 6e 64 6c 65 72 73 20 index $handlers
2790: 24 63 6f 6c 5d 0a 09 73 65 74 20 72 65 74 20 5b $col]..set ret [
27a0: 6d 76 65 63 20 24 76 3a 3a 6e 6f 64 65 28 24 68 mvec $v::node($h
27b0: 29 20 24 69 6e 64 65 78 5d 0a 0a 09 72 65 74 75 ) $index]...retu
27c0: 72 6e 20 24 72 65 74 0a 20 20 20 20 7d 0a 0a 20 rn $ret. }..
27d0: 20 20 20 70 72 6f 63 20 64 62 6f 70 65 6e 20 7b proc dbopen {
27e0: 64 62 20 66 69 6c 65 7d 20 7b 0a 09 23 20 6f 70 db file} {..# op
27f0: 65 6e 20 64 61 74 61 66 69 6c 65 2c 20 73 74 6f en datafile, sto
2800: 72 65 73 20 64 61 74 61 66 69 6c 65 20 64 65 73 res datafile des
2810: 63 72 69 70 74 6f 72 73 20 61 6e 64 20 73 74 61 criptors and sta
2820: 72 74 73 20 62 75 69 6c 64 69 6e 67 20 74 72 65 rts building tre
2830: 65 0a 09 69 66 20 7b 24 64 62 20 3d 3d 20 22 22 e..if {$db == ""
2840: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 20 7b } {.. set r {
2850: 7d 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 7b }.. foreach {
2860: 6b 20 76 7d 20 5b 61 72 72 61 79 20 67 65 74 20 k v} [array get
2870: 76 3a 3a 64 62 73 5d 20 7b 0a 09 09 6c 61 70 70 v::dbs] {...lapp
2880: 65 6e 64 20 72 20 24 6b 20 5b 6c 69 6e 64 65 78 end r $k [lindex
2890: 20 24 76 20 30 5d 0a 09 20 20 20 20 7d 0a 09 20 $v 0].. }..
28a0: 20 20 20 72 65 74 75 72 6e 20 24 72 0a 09 7d 0a return $r..}.
28b0: 09 66 65 74 63 68 20 24 66 69 6c 65 0a 09 68 65 .fetch $file..he
28c0: 61 64 65 72 0a 09 69 66 20 7b 5b 67 65 74 5f 76 ader..if {[get_v
28d0: 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 65 ] != 0} {.. e
28e0: 72 72 6f 72 20 22 64 62 6f 70 65 6e 3f 22 0a 09 rror "dbopen?"..
28f0: 7d 0a 09 73 65 74 20 64 65 73 63 20 5b 6c 61 79 }..set desc [lay
2900: 6f 75 74 20 5b 67 65 74 5f 73 20 5b 67 65 74 5f out [get_s [get_
2910: 76 5d 5d 5d 0a 09 6c 61 73 73 69 67 6e 20 5b 64 v]]]..lassign [d
2920: 65 73 63 70 61 72 73 65 20 24 64 65 73 63 5d 20 escparse $desc]
2930: 6e 61 6d 65 73 20 74 79 70 65 73 0a 09 73 65 74 names types..set
2940: 20 72 6f 6f 74 20 5b 67 65 74 5f 73 75 62 20 24 root [get_sub $
2950: 6e 61 6d 65 73 20 5b 6c 69 73 74 20 5b 70 72 65 names [list [pre
2960: 70 61 72 65 20 24 74 79 70 65 73 5d 5d 20 30 5d pare $types]] 0]
2970: 0a 09 73 65 74 20 76 3a 3a 64 62 73 28 24 64 62 ..set v::dbs($db
2980: 29 20 5b 6c 69 73 74 20 24 66 69 6c 65 20 24 76 ) [list $file $v
2990: 3a 3a 64 61 74 61 20 24 64 65 73 63 20 5b 6d 76 ::data $desc [mv
29a0: 65 63 20 24 72 6f 6f 74 20 30 5d 5d 0a 09 72 65 ec $root 0]]..re
29b0: 74 75 72 6e 20 24 64 62 0a 20 20 20 20 7d 0a 0a turn $db. }..
29c0: 20 20 20 20 70 72 6f 63 20 64 62 63 6c 6f 73 65 proc dbclose
29d0: 20 7b 64 62 7d 20 7b 0a 09 23 20 63 6c 6f 73 65 {db} {..# close
29e0: 20 64 61 74 61 66 69 6c 65 2c 20 67 65 74 20 72 datafile, get r
29f0: 69 64 20 6f 66 20 73 74 6f 72 65 64 20 69 6e 66 id of stored inf
2a00: 6f 0a 09 75 6e 73 65 74 20 76 3a 3a 64 62 73 28 o..unset v::dbs(
2a10: 24 64 62 29 0a 09 73 65 74 20 76 3a 3a 64 61 74 $db)..set v::dat
2a20: 61 20 22 22 20 3b 23 20 69 74 20 6d 61 79 20 62 a "" ;# it may b
2a30: 65 20 62 69 67 20 0a 20 20 20 20 7d 0a 0a 20 20 e big . }..
2a40: 20 20 70 72 6f 63 20 64 62 74 72 65 65 20 7b 64 proc dbtree {d
2a50: 62 7d 20 7b 0a 09 23 20 64 61 74 61 66 69 6c 65 b} {..# datafile
2a60: 20 73 65 6c 65 63 74 69 6f 6e 2c 20 66 69 72 73 selection, firs
2a70: 74 20 73 74 65 70 20 69 6e 20 61 63 63 65 73 73 t step in access
2a80: 20 6e 61 76 69 67 61 74 69 6f 6e 20 6c 6f 6f 70 navigation loop
2a90: 0a 09 72 65 74 75 72 6e 20 5b 6c 69 6e 64 65 78 ..return [lindex
2aa0: 20 24 76 3a 3a 64 62 73 28 24 64 62 29 20 33 5d $v::dbs($db) 3]
2ab0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 . }.. proc
2ac0: 20 61 63 63 65 73 73 20 7b 73 70 65 63 7d 20 7b access {spec} {
2ad0: 0a 09 23 20 74 68 69 73 20 69 73 20 74 68 65 20 ..# this is the
2ae0: 6d 61 69 6e 20 61 63 63 65 73 73 20 6e 61 76 69 main access navi
2af0: 67 61 74 69 6f 6e 20 6c 6f 6f 70 0a 09 73 65 74 gation loop..set
2b00: 20 73 20 5b 73 70 6c 69 74 20 24 73 70 65 63 20 s [split $spec
2b10: 22 2e 21 22 5d 0a 09 73 65 74 20 78 20 5b 6c 69 ".!"]..set x [li
2b20: 73 74 20 64 62 74 72 65 65 20 5b 61 72 72 61 79 st dbtree [array
2b30: 20 73 69 7a 65 20 76 3a 3a 64 62 73 5d 5d 0a 09 size v::dbs]]..
2b40: 66 6f 72 65 61 63 68 20 79 20 24 73 20 7b 0a 09 foreach y $s {..
2b50: 20 20 20 20 73 65 74 20 78 20 5b 6d 76 65 63 20 set x [mvec
2b60: 24 78 20 24 79 5d 0a 09 7d 0a 09 72 65 74 75 72 $x $y]..}..retur
2b70: 6e 20 24 78 0a 20 20 20 20 7d 0a 0a 20 20 20 20 n $x. }..
2b80: 70 72 6f 63 20 76 6e 61 6d 65 73 20 7b 76 69 65 proc vnames {vie
2b90: 77 7d 20 7b 0a 09 23 20 72 65 74 75 72 6e 20 61 w} {..# return a
2ba0: 20 6c 69 73 74 20 6f 66 20 70 72 6f 70 65 72 74 list of propert
2bb0: 79 20 6e 61 6d 65 73 0a 09 69 66 20 7b 5b 6c 69 y names..if {[li
2bc0: 6e 64 65 78 20 24 76 69 65 77 20 30 5d 20 21 3d ndex $view 0] !=
2bd0: 20 22 67 65 74 5f 76 69 65 77 22 7d 20 7b 0a 09 "get_view"} {..
2be0: 20 20 20 20 65 72 72 6f 72 20 22 76 6e 61 6d 65 error "vname
2bf0: 73 3f 22 0a 09 7d 0a 09 72 65 74 75 72 6e 20 5b s?"..}..return [
2c00: 6c 69 6e 64 65 78 20 24 76 69 65 77 20 31 5d 0a lindex $view 1].
2c10: 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 }.. proc
2c20: 76 6c 65 6e 20 7b 76 69 65 77 7d 20 7b 0a 09 23 vlen {view} {..#
2c30: 20 72 65 74 75 72 6e 20 74 68 65 20 6e 75 6d 62 return the numb
2c40: 65 72 20 6f 66 20 72 6f 77 73 20 69 6e 20 74 68 er of rows in th
2c50: 69 73 20 76 69 65 77 0a 09 69 66 20 7b 5b 6c 69 is view..if {[li
2c60: 6e 64 65 78 20 24 76 69 65 77 20 30 5d 20 21 3d ndex $view 0] !=
2c70: 20 22 67 65 74 5f 76 69 65 77 22 7d 20 7b 0a 09 "get_view"} {..
2c80: 20 20 20 20 65 72 72 6f 72 20 22 76 6c 65 6e 3f error "vlen?
2c90: 22 0a 09 7d 0a 09 72 65 74 75 72 6e 20 5b 6c 69 "..}..return [li
2ca0: 6e 64 65 78 20 24 76 69 65 77 20 32 5d 0a 20 20 ndex $view 2].
2cb0: 20 20 7d 0a 0a 20 20 20 20 23 20 76 69 6d 3a 20 }.. # vim:
2cc0: 66 74 3d 74 63 6c 0a 0a 7d 0a 0a 69 66 20 7b 5b ft=tcl..}..if {[
2cd0: 69 6e 66 6f 20 63 6f 6d 6d 20 6d 6b 5f 66 69 6c info comm mk_fil
2ce0: 65 5d 20 3d 3d 20 22 22 7d 20 7b 0a 20 20 20 20 e] == ""} {.
2cf0: 23 20 43 6f 6d 70 61 74 69 62 69 6c 69 74 79 20 # Compatibility
2d00: 6c 61 79 65 72 20 66 6f 72 20 4d 65 74 61 4b 69 layer for MetaKi
2d10: 74 0a 0a 20 20 20 20 23 20 72 65 71 75 69 72 65 t.. # require
2d20: 73 20 64 62 6f 70 65 6e 2f 64 62 63 6c 6f 73 65 s dbopen/dbclose
2d30: 2f 64 62 74 72 65 65 2f 61 63 63 65 73 73 2f 76 /dbtree/access/v
2d40: 6e 61 6d 65 73 2f 76 6c 65 6e 2f 6d 76 65 63 20 names/vlen/mvec
2d50: 70 72 69 6d 69 74 69 76 65 73 0a 20 20 20 20 23 primitives. #
2d60: 73 6f 75 72 63 65 20 5b 66 69 6c 65 20 6a 6f 69 source [file joi
2d70: 6e 20 5b 69 6e 66 6f 20 64 69 72 6e 61 6d 65 20 n [info dirname
2d80: 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 64 [info script]] d
2d90: 65 63 6f 64 65 2e 74 63 6c 5d 0a 0a 20 20 20 20 ecode.tcl]..
2da0: 6e 61 6d 65 73 70 61 63 65 20 65 78 70 6f 72 74 namespace export
2db0: 20 6d 6b 5f 2a 0a 0a 20 20 20 20 70 72 6f 63 20 mk_*.. proc
2dc0: 6d 6b 5f 66 69 6c 65 20 7b 63 6d 64 20 61 72 67 mk_file {cmd arg
2dd0: 73 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 s} {.#set indent
2de0: 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 [string repeat
2df0: 22 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 " " [info lev
2e00: 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 el]].#puts stder
2e10: 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 r "${indent}DEBU
2e20: 47 3a 20 6d 6b 3a 3a 66 69 6c 65 20 24 63 6d 64 G: mk::file $cmd
2e30: 20 24 61 72 67 73 22 0a 09 6c 61 73 73 69 67 6e $args"..lassign
2e40: 20 24 61 72 67 73 20 64 62 20 66 69 6c 65 0a 09 $args db file..
2e50: 73 77 69 74 63 68 20 24 63 6d 64 20 7b 0a 09 20 switch $cmd {..
2e60: 20 20 20 6f 70 65 6e 20 7b 0a 09 09 20 20 20 20 open {...
2e70: 72 65 74 75 72 6e 20 5b 64 62 6f 70 65 6e 20 24 return [dbopen $
2e80: 64 62 20 24 66 69 6c 65 5d 0a 09 09 7d 0a 09 20 db $file]...}..
2e90: 20 20 20 63 6c 6f 73 65 20 7b 0a 09 09 20 20 20 close {...
2ea0: 20 64 62 63 6c 6f 73 65 20 24 64 62 0a 09 09 7d dbclose $db...}
2eb0: 0a 09 20 20 20 20 76 69 65 77 73 20 7b 0a 09 09 .. views {...
2ec0: 20 20 20 20 72 65 74 75 72 6e 20 5b 76 6e 61 6d return [vnam
2ed0: 65 73 20 5b 64 62 74 72 65 65 20 24 64 62 5d 5d es [dbtree $db]]
2ee0: 0a 09 09 7d 0a 09 20 20 20 20 63 6f 6d 6d 69 74 ...}.. commit
2ef0: 20 7b 0a 0a 09 09 7d 0a 09 20 20 20 20 64 65 66 {....}.. def
2f00: 61 75 6c 74 20 7b 0a 09 09 20 20 20 20 65 72 72 ault {... err
2f10: 6f 72 20 22 6d 6b 5f 66 69 6c 65 20 24 63 6d 64 or "mk_file $cmd
2f20: 3f 22 0a 09 09 7d 0a 09 7d 0a 20 20 20 20 7d 0a ?"...}..}. }.
2f30: 0a 20 20 20 20 70 72 6f 63 20 6d 6b 5f 76 69 65 . proc mk_vie
2f40: 77 20 7b 63 6d 64 20 70 61 74 68 20 61 72 67 73 w {cmd path args
2f50: 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20 } {.#set indent
2f60: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 22 [string repeat "
2f70: 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65 " [info leve
2f80: 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72 l]].#puts stderr
2f90: 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47 "${indent}DEBUG
2fa0: 3a 20 6d 6b 3a 3a 76 69 65 77 20 24 63 6d 64 20 : mk::view $cmd
2fb0: 24 70 61 74 68 20 24 61 72 67 73 22 0a 09 6c 61 $path $args"..la
2fc0: 73 73 69 67 6e 20 24 61 72 67 73 20 61 31 0a 09 ssign $args a1..
2fd0: 73 77 69 74 63 68 20 24 63 6d 64 20 7b 0a 09 20 switch $cmd {..
2fe0: 20 20 20 69 6e 66 6f 20 7b 0a 09 09 20 20 20 20 info {...
2ff0: 72 65 74 75 72 6e 20 5b 76 6e 61 6d 65 73 20 5b return [vnames [
3000: 61 63 63 65 73 73 20 24 70 61 74 68 5d 5d 0a 09 access $path]]..
3010: 09 7d 0a 09 20 20 20 20 6c 61 79 6f 75 74 20 7b .}.. layout {
3020: 0a 09 09 20 20 20 20 73 65 74 20 6c 61 79 6f 75 ... set layou
3030: 74 20 22 4e 4f 54 59 45 54 22 0a 09 09 20 20 20 t "NOTYET"...
3040: 20 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 if {[llength $a
3050: 72 67 73 5d 20 3e 20 30 20 26 26 20 24 6c 61 79 rgs] > 0 && $lay
3060: 6f 75 74 20 21 3d 20 24 61 31 7d 20 7b 0a 09 09 out != $a1} {...
3070: 09 23 65 72 72 6f 72 20 22 76 69 65 77 20 72 65 .#error "view re
3080: 73 74 72 75 63 74 75 72 69 6e 67 20 6e 6f 74 20 structuring not
3090: 73 75 70 70 6f 72 74 65 64 22 0a 09 09 20 20 20 supported"...
30a0: 20 7d 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 }... return
30b0: 24 6c 61 79 6f 75 74 0a 09 09 7d 0a 09 20 20 20 $layout...}..
30c0: 20 73 69 7a 65 20 7b 0a 09 09 20 20 20 20 73 65 size {... se
30d0: 74 20 6c 65 6e 20 5b 76 6c 65 6e 20 5b 61 63 63 t len [vlen [acc
30e0: 65 73 73 20 24 70 61 74 68 5d 5d 0a 09 09 20 20 ess $path]]...
30f0: 20 20 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 if {[llength $
3100: 61 72 67 73 5d 20 3e 20 30 20 26 26 20 24 6c 65 args] > 0 && $le
3110: 6e 20 21 3d 20 24 61 31 7d 20 7b 0a 09 09 09 65 n != $a1} {....e
3120: 72 72 6f 72 20 22 76 69 65 77 20 72 65 73 69 7a rror "view resiz
3130: 69 6e 67 20 6e 6f 74 20 73 75 70 70 6f 72 74 65 ing not supporte
3140: 64 22 0a 09 09 20 20 20 20 7d 0a 09 09 20 20 20 d"... }...
3150: 20 72 65 74 75 72 6e 20 5b 76 6c 65 6e 20 5b 61 return [vlen [a
3160: 63 63 65 73 73 20 24 70 61 74 68 5d 5d 0a 09 09 ccess $path]]...
3170: 7d 0a 09 20 20 20 20 64 65 66 61 75 6c 74 20 7b }.. default {
3180: 0a 09 09 20 20 20 20 65 72 72 6f 72 20 22 6d 6b ... error "mk
3190: 5f 76 69 65 77 20 24 63 6d 64 3f 22 0a 09 09 7d _view $cmd?"...}
31a0: 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 ..}. }.. p
31b0: 72 6f 63 20 6d 6b 5f 63 75 72 73 6f 72 20 7b 63 roc mk_cursor {c
31c0: 6d 64 20 63 75 72 73 6f 72 20 61 72 67 73 7d 20 md cursor args}
31d0: 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20 5b 73 {.#set indent [s
31e0: 74 72 69 6e 67 20 72 65 70 65 61 74 20 22 20 20 tring repeat "
31f0: 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65 6c 5d " [info level]
3200: 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72 20 22 ].#puts stderr "
3210: 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47 3a 20 ${indent}DEBUG:
3220: 6d 6b 3a 3a 63 75 72 73 6f 72 20 24 63 6d 64 20 mk::cursor $cmd
3230: 24 63 75 72 73 6f 72 20 24 61 72 67 73 22 0a 09 $cursor $args"..
3240: 75 70 76 61 72 20 24 63 75 72 73 6f 72 20 76 0a upvar $cursor v.
3250: 09 73 77 69 74 63 68 20 24 63 6d 64 20 7b 0a 09 .switch $cmd {..
3260: 20 20 20 20 63 72 65 61 74 65 20 7b 0a 09 09 20 create {...
3270: 20 20 20 4e 4f 54 59 45 54 0a 09 09 7d 0a 09 20 NOTYET...}..
3280: 20 20 20 69 6e 63 72 20 7b 0a 09 09 20 20 20 20 incr {...
3290: 4e 4f 54 59 45 54 0a 09 09 7d 0a 09 20 20 20 20 NOTYET...}..
32a0: 70 6f 73 20 2d 0a 09 20 20 20 20 70 6f 73 69 74 pos -.. posit
32b0: 69 6f 6e 20 7b 0a 09 09 20 20 20 20 69 66 20 7b ion {... if {
32c0: 24 61 72 67 73 20 21 3d 20 22 22 7d 20 7b 0a 09 $args != ""} {..
32d0: 09 09 72 65 67 73 75 62 20 7b 21 2d 3f 5c 64 2b ..regsub {!-?\d+
32e0: 24 7d 20 24 76 20 7b 7d 20 76 0a 09 09 09 61 70 $} $v {} v....ap
32f0: 70 65 6e 64 20 76 20 21 24 61 72 67 73 0a 09 09 pend v !$args...
3300: 09 72 65 74 75 72 6e 20 24 61 72 67 73 0a 09 09 .return $args...
3310: 20 20 20 20 7d 0a 09 09 20 20 20 20 69 66 20 7b }... if {
3320: 21 5b 72 65 67 65 78 70 20 7b 5c 64 2b 24 7d 20 ![regexp {\d+$}
3330: 24 76 20 6e 5d 7d 20 7b 0a 09 09 09 73 65 74 20 $v n]} {....set
3340: 6e 20 2d 31 0a 09 09 20 20 20 20 7d 0a 09 09 20 n -1... }...
3350: 20 20 20 72 65 74 75 72 6e 20 24 6e 0a 09 09 7d return $n...}
3360: 0a 09 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a .. default {.
3370: 09 09 20 20 20 20 65 72 72 6f 72 20 22 6d 6b 5f .. error "mk_
3380: 63 75 72 73 6f 72 20 24 63 6d 64 3f 22 0a 09 09 cursor $cmd?"...
3390: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 }..}. }..
33a0: 70 72 6f 63 20 6d 6b 5f 67 65 74 20 7b 70 61 74 proc mk_get {pat
33b0: 68 20 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 h args} {.#set i
33c0: 6e 64 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 ndent [string re
33d0: 70 65 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 peat " " [inf
33e0: 6f 20 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 o level]].#puts
33f0: 73 74 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 stderr "${indent
3400: 7d 44 45 42 55 47 3a 20 6d 6b 3a 3a 67 65 74 20 }DEBUG: mk::get
3410: 24 70 61 74 68 20 24 61 72 67 73 22 0a 09 73 65 $path $args"..se
3420: 74 20 72 6f 77 72 65 66 20 5b 61 63 63 65 73 73 t rowref [access
3430: 20 24 70 61 74 68 5d 0a 09 73 65 74 20 73 69 7a $path]..set siz
3440: 65 64 20 30 0a 09 69 66 20 7b 5b 6c 69 6e 64 65 ed 0..if {[linde
3450: 78 20 24 61 72 67 73 20 30 5d 20 3d 3d 20 22 2d x $args 0] == "-
3460: 73 69 7a 65 22 7d 20 7b 0a 09 20 20 20 20 73 65 size"} {.. se
3470: 74 20 73 69 7a 65 64 20 31 0a 09 20 20 20 20 73 t sized 1.. s
3480: 65 74 20 61 72 67 73 20 5b 6c 72 61 6e 67 65 20 et args [lrange
3490: 24 61 72 67 73 20 31 20 65 6e 64 5d 0a 09 7d 0a $args 1 end]..}.
34a0: 09 73 65 74 20 69 64 73 20 30 0a 09 69 66 20 7b .set ids 0..if {
34b0: 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 [llength $args]
34c0: 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 == 0} {.. set
34d0: 20 61 72 67 73 20 5b 76 6e 61 6d 65 73 20 24 72 args [vnames $r
34e0: 6f 77 72 65 66 5d 0a 09 20 20 20 20 73 65 74 20 owref].. set
34f0: 69 64 73 20 31 0a 09 7d 0a 09 73 65 74 20 72 20 ids 1..}..set r
3500: 7b 7d 0a 09 66 6f 72 65 61 63 68 20 78 20 24 61 {}..foreach x $a
3510: 72 67 73 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 rgs {.. if {$
3520: 69 64 73 7d 20 7b 0a 09 09 6c 61 70 70 65 6e 64 ids} {...lappend
3530: 20 72 20 24 78 0a 09 20 20 20 20 7d 0a 09 20 20 r $x.. }..
3540: 20 20 73 65 74 20 76 20 5b 6d 76 65 63 20 24 72 set v [mvec $r
3550: 6f 77 72 65 66 20 24 78 5d 0a 69 66 20 7b 5b 73 owref $x].if {[s
3560: 74 72 69 6e 67 20 72 61 6e 67 65 20 24 76 20 30 tring range $v 0
3570: 20 38 5d 20 3d 3d 20 22 67 65 74 5f 76 69 65 77 8] == "get_view
3580: 20 22 7d 20 7b 0a 23 20 58 58 58 3a 20 3f 21 3f "} {.# XXX: ?!?
3590: 21 3f 3a 20 54 4f 44 4f 3a 20 46 49 58 0a 73 65 !?: TODO: FIX.se
35a0: 74 20 76 20 31 0a 7d 0a 09 20 20 20 20 63 61 74 t v 1.}.. cat
35b0: 63 68 20 7b 0a 09 09 73 65 74 20 76 20 5b 7a 6c ch {...set v [zl
35c0: 69 62 20 64 65 63 6f 6d 70 72 65 73 73 20 24 76 ib decompress $v
35d0: 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 ].. }.. if
35e0: 20 7b 24 73 69 7a 65 64 7d 20 7b 0a 09 09 6c 61 {$sized} {...la
35f0: 70 70 65 6e 64 20 72 20 5b 73 74 72 69 6e 67 20 ppend r [string
3600: 6c 65 6e 67 74 68 20 24 76 5d 0a 09 20 20 20 20 length $v]..
3610: 7d 20 65 6c 73 65 20 7b 0a 09 09 6c 61 70 70 65 } else {...lappe
3620: 6e 64 20 72 20 24 76 0a 09 20 20 20 20 7d 0a 09 nd r $v.. }..
3630: 7d 0a 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 }..if {[llength
3640: 24 61 72 67 73 5d 20 3d 3d 20 31 7d 20 7b 0a 09 $args] == 1} {..
3650: 20 20 20 20 73 65 74 20 72 20 5b 6c 69 6e 64 65 set r [linde
3660: 78 20 24 72 20 30 5d 0a 09 7d 0a 0a 09 72 65 74 x $r 0]..}...ret
3670: 75 72 6e 20 24 72 0a 20 20 20 20 7d 0a 0a 20 20 urn $r. }..
3680: 20 20 70 72 6f 63 20 6d 6b 5f 6c 6f 6f 70 20 7b proc mk_loop {
3690: 63 75 72 73 6f 72 20 70 61 74 68 20 61 72 67 73 cursor path args
36a0: 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20 } {.#set indent
36b0: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 22 [string repeat "
36c0: 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65 " [info leve
36d0: 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72 l]].#puts stderr
36e0: 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47 "${indent}DEBUG
36f0: 3a 20 6d 6b 3a 3a 6c 6f 6f 70 20 24 63 75 72 73 : mk::loop $curs
3700: 6f 72 20 24 70 61 74 68 20 2e 2e 2e 22 0a 09 75 or $path ..."..u
3710: 70 76 61 72 20 24 63 75 72 73 6f 72 20 76 0a 09 pvar $cursor v..
3720: 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 72 if {[llength $ar
3730: 67 73 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 gs] == 0} {..
3740: 20 73 65 74 20 61 72 67 73 20 5b 6c 69 73 74 20 set args [list
3750: 24 70 61 74 68 5d 0a 09 20 20 20 20 73 65 74 20 $path].. set
3760: 70 61 74 68 20 24 76 0a 09 20 20 20 20 72 65 67 path $v.. reg
3770: 73 75 62 20 7b 21 2d 3f 5c 64 2b 24 7d 20 24 70 sub {!-?\d+$} $p
3780: 61 74 68 20 7b 7d 20 70 61 74 68 0a 09 7d 0a 09 ath {} path..}..
3790: 6c 61 73 73 69 67 6e 20 24 61 72 67 73 20 61 31 lassign $args a1
37a0: 20 61 32 20 61 33 20 61 34 0a 09 73 65 74 20 72 a2 a3 a4..set r
37b0: 6f 77 72 65 66 20 5b 61 63 63 65 73 73 20 24 70 owref [access $p
37c0: 61 74 68 5d 0a 09 73 65 74 20 66 69 72 73 74 20 ath]..set first
37d0: 30 0a 09 73 65 74 20 6c 69 6d 69 74 20 5b 76 6c 0..set limit [vl
37e0: 65 6e 20 24 72 6f 77 72 65 66 5d 0a 09 73 65 74 en $rowref]..set
37f0: 20 73 74 65 70 20 31 0a 09 73 77 69 74 63 68 20 step 1..switch
3800: 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 [llength $args]
3810: 7b 0a 09 20 20 20 20 31 20 7b 0a 09 09 20 20 20 {.. 1 {...
3820: 20 73 65 74 20 62 6f 64 79 20 24 61 31 0a 09 09 set body $a1...
3830: 7d 0a 09 20 20 20 20 32 20 7b 0a 09 09 20 20 20 }.. 2 {...
3840: 20 73 65 74 20 66 69 72 73 74 20 24 61 31 0a 09 set first $a1..
3850: 09 20 20 20 20 73 65 74 20 62 6f 64 79 20 24 61 . set body $a
3860: 32 0a 09 09 7d 0a 09 20 20 20 20 33 20 7b 0a 09 2...}.. 3 {..
3870: 09 20 20 20 20 73 65 74 20 66 69 72 73 74 20 24 . set first $
3880: 61 31 0a 09 09 20 20 20 20 73 65 74 20 6c 69 6d a1... set lim
3890: 69 74 20 24 61 32 0a 09 09 20 20 20 20 73 65 74 it $a2... set
38a0: 20 62 6f 64 79 20 24 61 33 0a 09 09 7d 0a 09 20 body $a3...}..
38b0: 20 20 20 34 20 7b 0a 09 09 20 20 20 20 73 65 74 4 {... set
38c0: 20 66 69 72 73 74 20 24 61 31 0a 09 09 20 20 20 first $a1...
38d0: 20 73 65 74 20 6c 69 6d 69 74 20 24 61 32 0a 09 set limit $a2..
38e0: 09 20 20 20 20 73 65 74 20 73 74 65 70 20 24 61 . set step $a
38f0: 33 0a 09 09 20 20 20 20 73 65 74 20 62 6f 64 79 3... set body
3900: 20 24 61 34 0a 09 09 7d 0a 09 20 20 20 20 64 65 $a4...}.. de
3910: 66 61 75 6c 74 20 7b 0a 09 09 20 20 20 20 65 72 fault {... er
3920: 72 6f 72 20 22 6d 6b 5f 6c 6f 6f 70 20 61 72 67 ror "mk_loop arg
3930: 20 63 6f 75 6e 74 3f 22 0a 09 09 7d 0a 09 7d 0a count?"...}..}.
3940: 09 73 65 74 20 63 6f 64 65 20 30 0a 09 66 6f 72 .set code 0..for
3950: 20 7b 73 65 74 20 69 20 24 66 69 72 73 74 7d 20 {set i $first}
3960: 7b 24 69 20 3c 20 24 6c 69 6d 69 74 7d 20 7b 69 {$i < $limit} {i
3970: 6e 63 72 20 69 20 24 73 74 65 70 7d 20 7b 0a 09 ncr i $step} {..
3980: 20 20 20 20 73 65 74 20 76 20 24 70 61 74 68 21 set v $path!
3990: 24 69 0a 09 20 20 20 20 73 65 74 20 63 6f 64 65 $i.. set code
39a0: 20 5b 63 61 74 63 68 20 5b 6c 69 73 74 20 75 70 [catch [list up
39b0: 6c 65 76 65 6c 20 31 20 24 62 6f 64 79 5d 20 65 level 1 $body] e
39c0: 72 72 5d 0a 09 20 20 20 20 73 77 69 74 63 68 20 rr].. switch
39d0: 24 63 6f 64 65 20 7b 0a 09 09 31 20 2d 0a 09 09 $code {...1 -...
39e0: 32 20 7b 0a 09 09 09 72 65 74 75 72 6e 20 2d 63 2 {....return -c
39f0: 6f 64 65 20 24 63 6f 64 65 20 24 65 72 72 0a 09 ode $code $err..
3a00: 09 20 20 20 20 7d 0a 09 09 33 20 7b 0a 09 09 09 . }...3 {....
3a10: 62 72 65 61 6b 0a 09 09 20 20 20 20 7d 0a 09 20 break... }..
3a20: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 }..}. }..
3a30: 20 20 20 70 72 6f 63 20 6d 6b 5f 73 65 6c 65 63 proc mk_selec
3a40: 74 20 7b 70 61 74 68 20 61 72 67 73 7d 20 7b 0a t {path args} {.
3a50: 23 73 65 74 20 69 6e 64 65 6e 74 20 5b 73 74 72 #set indent [str
3a60: 69 6e 67 20 72 65 70 65 61 74 20 22 20 20 20 20 ing repeat "
3a70: 22 20 5b 69 6e 66 6f 20 6c 65 76 65 6c 5d 5d 0a " [info level]].
3a80: 23 70 75 74 73 20 73 74 64 65 72 72 20 22 24 7b #puts stderr "${
3a90: 69 6e 64 65 6e 74 7d 44 45 42 55 47 3a 20 6d 6b indent}DEBUG: mk
3aa0: 3a 3a 73 65 6c 65 63 74 20 24 70 61 74 68 20 24 ::select $path $
3ab0: 61 72 67 73 22 0a 09 23 20 6f 6e 6c 79 20 68 61 args"..# only ha
3ac0: 6e 64 6c 65 20 74 68 65 20 73 69 6d 70 6c 65 73 ndle the simples
3ad0: 74 20 63 61 73 65 3a 20 65 78 61 63 74 20 6d 61 t case: exact ma
3ae0: 74 63 68 65 73 0a 09 69 66 20 7b 5b 6c 69 6e 64 tches..if {[lind
3af0: 65 78 20 24 61 72 67 73 20 30 5d 20 3d 3d 20 22 ex $args 0] == "
3b00: 2d 63 6f 75 6e 74 22 7d 20 7b 0a 09 09 73 65 74 -count"} {...set
3b10: 20 6d 61 78 69 74 65 6d 73 20 5b 6c 69 6e 64 65 maxitems [linde
3b20: 78 20 24 61 72 67 73 20 31 5d 0a 09 09 73 65 74 x $args 1]...set
3b30: 20 61 72 67 73 20 5b 6c 72 61 6e 67 65 20 24 61 args [lrange $a
3b40: 72 67 73 20 32 20 65 6e 64 5d 0a 09 7d 0a 0a 09 rgs 2 end]..}...
3b50: 73 65 74 20 63 75 72 72 6d 61 74 63 68 6d 6f 64 set currmatchmod
3b60: 65 20 22 63 61 73 65 69 6e 73 65 6e 73 69 74 69 e "caseinsensiti
3b70: 76 65 22 0a 0a 09 73 65 74 20 6b 65 79 73 20 7b ve"...set keys {
3b80: 7d 0a 09 73 65 74 20 76 61 6c 75 65 20 7b 7d 0a }..set value {}.
3b90: 09 73 65 74 20 6d 61 74 63 68 6d 6f 64 65 73 20 .set matchmodes
3ba0: 7b 7d 0a 09 66 6f 72 20 7b 73 65 74 20 69 64 78 {}..for {set idx
3bb0: 20 30 7d 20 7b 24 69 64 78 20 3c 20 5b 6c 6c 65 0} {$idx < [lle
3bc0: 6e 67 74 68 20 24 61 72 67 73 5d 7d 20 7b 69 6e ngth $args]} {in
3bd0: 63 72 20 69 64 78 20 32 7d 20 7b 0a 09 09 73 77 cr idx 2} {...sw
3be0: 69 74 63 68 20 2d 67 6c 6f 62 20 2d 2d 20 5b 6c itch -glob -- [l
3bf0: 69 6e 64 65 78 20 24 61 72 67 73 20 24 69 64 78 index $args $idx
3c00: 5d 20 7b 0a 09 09 09 22 2d 67 6c 6f 62 22 20 7b ] {...."-glob" {
3c10: 0a 09 09 09 09 73 65 74 20 63 75 72 72 6d 61 74 .....set currmat
3c20: 63 68 6d 6f 64 65 20 22 67 6c 6f 62 22 0a 09 09 chmode "glob"...
3c30: 09 09 69 6e 63 72 20 69 64 78 20 2d 31 0a 09 09 ..incr idx -1...
3c40: 09 09 63 6f 6e 74 69 6e 75 65 0a 09 09 09 7d 0a ..continue....}.
3c50: 09 09 09 22 2d 2a 22 20 7b 0a 09 09 09 09 65 72 ..."-*" {.....er
3c60: 72 6f 72 20 22 55 6e 68 61 6e 64 6c 65 64 20 6f ror "Unhandled o
3c70: 70 74 69 6f 6e 3a 20 5b 6c 69 6e 64 65 78 20 24 ption: [lindex $
3c80: 61 72 67 73 20 24 69 64 78 5d 22 0a 09 09 09 7d args $idx]"....}
3c90: 0a 09 09 7d 0a 0a 09 09 73 65 74 20 6b 20 5b 6c ...}....set k [l
3ca0: 69 6e 64 65 78 20 24 61 72 67 73 20 24 69 64 78 index $args $idx
3cb0: 5d 0a 09 09 73 65 74 20 76 20 5b 6c 69 6e 64 65 ]...set v [linde
3cc0: 78 20 24 61 72 67 73 20 5b 65 78 70 72 20 7b 24 x $args [expr {$
3cd0: 69 64 78 2b 31 7d 5d 5d 0a 0a 09 09 6c 61 70 70 idx+1}]]....lapp
3ce0: 65 6e 64 20 6b 65 79 73 20 24 6b 0a 09 09 6c 61 end keys $k...la
3cf0: 70 70 65 6e 64 20 76 61 6c 75 65 73 20 24 76 0a ppend values $v.
3d00: 09 09 6c 61 70 70 65 6e 64 20 6d 61 74 63 68 6d ..lappend matchm
3d10: 6f 64 65 73 20 24 63 75 72 72 6d 61 74 63 68 6d odes $currmatchm
3d20: 6f 64 65 0a 09 7d 0a 09 73 65 74 20 72 20 7b 7d ode..}..set r {}
3d30: 0a 09 6d 6b 5f 6c 6f 6f 70 20 63 20 24 70 61 74 ..mk_loop c $pat
3d40: 68 20 7b 0a 09 09 73 65 74 20 78 20 5b 65 76 61 h {...set x [eva
3d50: 6c 20 6d 6b 5f 67 65 74 20 24 63 20 24 6b 65 79 l mk_get $c $key
3d60: 73 5d 0a 09 09 73 65 74 20 6d 61 74 63 68 43 6e s]...set matchCn
3d70: 74 20 30 0a 09 09 66 6f 72 20 7b 73 65 74 20 69 t 0...for {set i
3d80: 64 78 20 30 7d 20 7b 24 69 64 78 20 3c 20 5b 6c dx 0} {$idx < [l
3d90: 6c 65 6e 67 74 68 20 24 78 5d 7d 20 7b 69 6e 63 length $x]} {inc
3da0: 72 20 69 64 78 7d 20 7b 0a 09 09 09 73 65 74 20 r idx} {....set
3db0: 76 61 6c 20 5b 6c 69 6e 64 65 78 20 24 76 61 6c val [lindex $val
3dc0: 75 65 73 20 24 69 64 78 5d 0a 09 09 09 73 65 74 ues $idx]....set
3dd0: 20 63 68 6b 76 61 6c 20 5b 6c 69 6e 64 65 78 20 chkval [lindex
3de0: 24 78 20 24 69 64 78 5d 0a 09 09 09 73 65 74 20 $x $idx]....set
3df0: 6d 61 74 63 68 6d 6f 64 65 20 5b 6c 69 6e 64 65 matchmode [linde
3e00: 78 20 24 6d 61 74 63 68 6d 6f 64 65 73 20 24 69 x $matchmodes $i
3e10: 64 78 5d 0a 0a 09 09 09 73 77 69 74 63 68 20 2d dx].....switch -
3e20: 2d 20 24 6d 61 74 63 68 6d 6f 64 65 20 7b 0a 09 - $matchmode {..
3e30: 09 09 09 22 63 61 73 65 69 6e 73 65 6e 73 69 74 ..."caseinsensit
3e40: 69 76 65 22 20 7b 0a 09 09 09 09 09 69 66 20 7b ive" {......if {
3e50: 24 76 61 6c 20 3d 3d 20 24 63 68 6b 76 61 6c 7d $val == $chkval}
3e60: 20 7b 0a 09 09 09 09 09 09 69 6e 63 72 20 6d 61 {.......incr ma
3e70: 74 63 68 43 6e 74 0a 09 09 09 09 09 7d 0a 09 09 tchCnt......}...
3e80: 09 09 7d 0a 09 09 09 09 22 67 6c 6f 62 22 20 7b ..}....."glob" {
3e90: 0a 09 09 09 09 09 69 66 20 7b 5b 73 74 72 69 6e ......if {[strin
3ea0: 67 20 6d 61 74 63 68 20 24 76 61 6c 20 24 63 68 g match $val $ch
3eb0: 6b 76 61 6c 5d 7d 20 7b 0a 09 09 09 09 09 09 69 kval]} {.......i
3ec0: 6e 63 72 20 6d 61 74 63 68 43 6e 74 0a 09 09 09 ncr matchCnt....
3ed0: 09 09 7d 0a 09 09 09 09 7d 0a 09 09 09 7d 0a 0a ..}.....}....}..
3ee0: 09 09 7d 0a 09 09 69 66 20 7b 24 6d 61 74 63 68 ..}...if {$match
3ef0: 43 6e 74 20 3d 3d 20 5b 6c 6c 65 6e 67 74 68 20 Cnt == [llength
3f00: 24 6b 65 79 73 5d 7d 20 7b 0a 09 09 09 6c 61 70 $keys]} {....lap
3f10: 70 65 6e 64 20 72 20 5b 6d 6b 5f 63 75 72 73 6f pend r [mk_curso
3f20: 72 20 70 6f 73 69 74 69 6f 6e 20 63 5d 0a 09 09 r position c]...
3f30: 7d 0a 09 7d 0a 0a 09 69 66 20 7b 5b 69 6e 66 6f }..}...if {[info
3f40: 20 65 78 69 73 74 73 20 6d 61 78 69 74 65 6d 73 exists maxitems
3f50: 5d 7d 20 7b 0a 09 09 73 65 74 20 72 20 5b 6c 72 ]} {...set r [lr
3f60: 61 6e 67 65 20 24 72 20 30 20 5b 65 78 70 72 20 ange $r 0 [expr
3f70: 24 6d 61 78 69 74 65 6d 73 20 2d 20 31 5d 5d 0a $maxitems - 1]].
3f80: 09 7d 0a 0a 09 72 65 74 75 72 6e 20 24 72 0a 20 .}...return $r.
3f90: 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d }.. proc m
3fa0: 6b 5f 5f 72 65 63 68 61 6e 20 7b 70 61 74 68 20 k__rechan {path
3fb0: 70 72 6f 70 20 63 6d 64 20 63 68 61 6e 20 61 72 prop cmd chan ar
3fc0: 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e gs} {.#set inden
3fd0: 74 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 t [string repeat
3fe0: 20 22 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 " " [info le
3ff0: 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 vel]].#puts stde
4000: 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 rr "${indent}DEB
4010: 55 47 3a 20 6d 6b 3a 3a 5f 72 65 63 68 61 6e 20 UG: mk::_rechan
4020: 24 70 61 74 68 20 24 70 72 6f 70 20 24 63 6d 64 $path $prop $cmd
4030: 20 24 63 68 61 6e 20 24 61 72 67 73 22 0a 0a 20 $chan $args"..
4040: 20 20 20 20 20 20 20 73 65 74 20 6b 65 79 20 5b set key [
4050: 6c 69 73 74 20 24 70 61 74 68 20 24 70 72 6f 70 list $path $prop
4060: 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b 21 5b ]. if {![
4070: 69 6e 66 6f 20 65 78 69 73 74 73 20 3a 3a 6d 6b info exists ::mk
4080: 5f 5f 63 61 63 68 65 28 24 6b 65 79 29 5d 7d 20 __cache($key)]}
4090: 7b 0a 20 20 20 20 20 20 20 20 20 20 73 65 74 20 {. set
40a0: 3a 3a 6d 6b 5f 5f 63 61 63 68 65 28 24 6b 65 79 ::mk__cache($key
40b0: 29 20 5b 6d 6b 3a 3a 67 65 74 20 24 70 61 74 68 ) [mk::get $path
40c0: 20 24 70 72 6f 70 5d 0a 20 20 20 20 20 20 20 20 $prop].
40d0: 7d 0a 20 20 20 20 20 20 20 20 69 66 20 7b 21 5b }. if {![
40e0: 69 6e 66 6f 20 65 78 69 73 74 73 20 3a 3a 6d 6b info exists ::mk
40f0: 5f 5f 6f 66 66 73 65 74 28 24 6b 65 79 29 5d 7d __offset($key)]}
4100: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 73 65 74 {. set
4110: 20 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 74 28 24 6b ::mk__offset($k
4120: 65 79 29 20 30 0a 20 20 20 20 20 20 20 20 7d 0a ey) 0. }.
4130: 20 20 20 20 20 20 20 20 73 65 74 20 64 61 74 61 set data
4140: 20 24 3a 3a 6d 6b 5f 5f 63 61 63 68 65 28 24 6b $::mk__cache($k
4150: 65 79 29 0a 20 20 20 20 20 20 20 20 73 65 74 20 ey). set
4160: 6f 66 66 73 65 74 20 24 3a 3a 6d 6b 5f 5f 6f 66 offset $::mk__of
4170: 66 73 65 74 28 24 6b 65 79 29 0a 0a 20 20 20 20 fset($key)..
4180: 20 20 20 20 73 77 69 74 63 68 20 2d 2d 20 24 63 switch -- $c
4190: 6d 64 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 md {.
41a0: 20 22 72 65 61 64 22 20 7b 0a 20 20 20 20 20 20 "read" {.
41b0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 63 6f set co
41c0: 75 6e 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 unt [lindex $arg
41d0: 73 20 30 5d 0a 20 20 20 20 20 20 20 20 20 20 20 s 0].
41e0: 20 20 20 20 20 73 65 74 20 72 65 74 76 61 6c 20 set retval
41f0: 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 24 64 [string range $d
4200: 61 74 61 20 24 6f 66 66 73 65 74 20 5b 65 78 70 ata $offset [exp
4210: 72 20 7b 24 6f 66 66 73 65 74 20 2b 20 24 63 6f r {$offset + $co
4220: 75 6e 74 20 2d 20 31 7d 5d 5d 0a 0a 20 20 20 20 unt - 1}]]..
4230: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
4240: 72 65 61 64 62 79 74 65 73 20 5b 73 74 72 69 6e readbytes [strin
4250: 67 20 6c 65 6e 67 74 68 20 24 72 65 74 76 61 6c g length $retval
4260: 5d 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ]..
4270: 20 20 20 69 6e 63 72 20 6f 66 66 73 65 74 20 24 incr offset $
4280: 72 65 61 64 62 79 74 65 73 0a 20 20 20 20 20 20 readbytes.
4290: 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 }.
42a0: 20 20 20 20 22 63 6c 6f 73 65 22 20 7b 0a 20 20 "close" {.
42b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 75 6e un
42c0: 73 65 74 20 2d 6e 6f 63 6f 6d 70 6c 61 69 6e 20 set -nocomplain
42d0: 3a 3a 6d 6b 5f 5f 63 61 63 68 65 28 24 6b 65 79 ::mk__cache($key
42e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
42f0: 20 20 75 6e 73 65 74 20 2d 6e 6f 63 6f 6d 70 6c unset -nocompl
4300: 61 69 6e 20 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 74 ain ::mk__offset
4310: 28 24 6b 65 79 29 0a 20 20 20 20 20 20 20 20 20 ($key).
4320: 20 20 20 20 20 20 20 72 65 74 75 72 6e 0a 20 20 return.
4330: 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 }.
4340: 20 20 20 20 20 20 20 20 64 65 66 61 75 6c 74 20 default
4350: 7b 0a 23 70 75 74 73 20 73 74 64 65 72 72 20 22 {.#puts stderr "
4360: 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47 3a 20 ${indent}DEBUG:
4370: 6d 6b 3a 3a 5f 72 65 63 68 61 6e 3a 20 43 61 6c mk::_rechan: Cal
4380: 6c 65 64 20 66 6f 72 20 63 6d 64 20 24 63 6d 64 led for cmd $cmd
4390: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
43a0: 20 20 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 return -code e
43b0: 72 72 6f 72 20 22 4e 6f 74 20 69 6d 70 6c 65 6d rror "Not implem
43c0: 65 6e 74 65 64 3a 20 63 6d 64 20 3d 20 24 63 6d ented: cmd = $cm
43d0: 64 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 7d d". }
43e0: 0a 20 20 20 20 20 20 20 20 7d 0a 0a 20 20 20 20 . }..
43f0: 20 20 20 20 73 65 74 20 3a 3a 6d 6b 5f 5f 6f 66 set ::mk__of
4400: 66 73 65 74 28 24 6b 65 79 29 20 24 6f 66 66 73 fset($key) $offs
4410: 65 74 0a 0a 09 72 65 74 75 72 6e 20 24 72 65 74 et...return $ret
4420: 76 61 6c 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 val. }.. p
4430: 72 6f 63 20 6d 6b 5f 63 68 61 6e 6e 65 6c 20 7b roc mk_channel {
4440: 70 61 74 68 20 70 72 6f 70 20 7b 6d 6f 64 65 20 path prop {mode
4450: 22 72 22 7d 7d 20 7b 0a 23 73 65 74 20 69 6e 64 "r"}} {.#set ind
4460: 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 65 ent [string repe
4470: 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f 20 at " " [info
4480: 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74 level]].#puts st
4490: 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44 derr "${indent}D
44a0: 45 42 55 47 3a 20 6d 6b 3a 3a 63 68 61 6e 6e 65 EBUG: mk::channe
44b0: 6c 20 24 70 61 74 68 20 24 70 72 6f 70 20 24 6d l $path $prop $m
44c0: 6f 64 65 22 0a 09 73 65 74 20 66 64 20 5b 72 65 ode"..set fd [re
44d0: 63 68 61 6e 20 5b 6c 69 73 74 20 6d 6b 5f 5f 72 chan [list mk__r
44e0: 65 63 68 61 6e 20 24 70 61 74 68 20 24 70 72 6f echan $path $pro
44f0: 70 5d 20 32 5d 0a 0a 09 72 65 74 75 72 6e 20 24 p] 2]...return $
4500: 66 64 0a 20 20 20 20 7d 0a 20 20 20 20 23 20 76 fd. }. # v
4510: 69 6d 3a 20 66 74 3d 74 63 6c 0a 0a 7d 0a 0a 23 im: ft=tcl..}..#
4520: 20 73 65 74 20 75 70 20 74 68 65 20 4d 65 74 61 set up the Meta
4530: 4b 69 74 20 63 6f 6d 70 61 74 69 62 69 6c 69 74 Kit compatibilit
4540: 79 20 64 65 66 69 6e 69 74 69 6f 6e 73 0a 66 6f y definitions.fo
4550: 72 65 61 63 68 20 78 20 7b 66 69 6c 65 20 76 69 reach x {file vi
4560: 65 77 20 63 75 72 73 6f 72 20 67 65 74 20 6c 6f ew cursor get lo
4570: 6f 70 20 73 65 6c 65 63 74 20 63 68 61 6e 6e 65 op select channe
4580: 6c 7d 20 7b 0a 20 20 20 20 69 6e 74 65 72 70 20 l} {. interp
4590: 61 6c 69 61 73 20 7b 7d 20 3a 3a 6d 6b 3a 3a 24 alias {} ::mk::$
45a0: 78 20 7b 7d 20 3a 3a 6d 6b 5f 24 78 0a 7d 0a 0a x {} ::mk_$x.}..
45b0: 70 61 63 6b 61 67 65 20 70 72 6f 76 69 64 65 20 package provide
45c0: 4d 6b 34 74 63 6c 20 32 2e 34 2e 30 2e 31 0a Mk4tcl 2.4.0.1.