Artifact 122176da293daccca87927a43fa6a0e4640dc94e:
- File
kitsh/buildsrc/kitsh-0.0/mk4tcl.tcl
— part of check-in
[096098536d]
at
2010-09-26 04:42:20
on branch trunk
— Updated to implement "vfs::mkcl" using Readkit
Updated local Readkit implementation to not attempt to replace Mk4tcl (user: rkeene, size: 34093) [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 72 65 61 64 6b 69 74 3a 3a 66 69 6c 65 G: readkit::file 2e30: 20 24 63 6d 64 20 24 61 72 67 73 22 0a 09 6c 61 $cmd $args"..la 2e40: 73 73 69 67 6e 20 24 61 72 67 73 20 64 62 20 66 ssign $args db f 2e50: 69 6c 65 0a 09 73 77 69 74 63 68 20 24 63 6d 64 ile..switch $cmd 2e60: 20 7b 0a 09 20 20 20 20 6f 70 65 6e 20 7b 0a 09 {.. open {.. 2e70: 09 20 20 20 20 72 65 74 75 72 6e 20 5b 64 62 6f . return [dbo 2e80: 70 65 6e 20 24 64 62 20 24 66 69 6c 65 5d 0a 09 pen $db $file].. 2e90: 09 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 7b 0a .}.. close {. 2ea0: 09 09 20 20 20 20 64 62 63 6c 6f 73 65 20 24 64 .. dbclose $d 2eb0: 62 0a 09 09 7d 0a 09 20 20 20 20 76 69 65 77 73 b...}.. views 2ec0: 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 {... return 2ed0: 5b 76 6e 61 6d 65 73 20 5b 64 62 74 72 65 65 20 [vnames [dbtree 2ee0: 24 64 62 5d 5d 0a 09 09 7d 0a 09 20 20 20 20 63 $db]]...}.. c 2ef0: 6f 6d 6d 69 74 20 7b 0a 0a 09 09 7d 0a 09 20 20 ommit {....}.. 2f00: 20 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 20 20 default {... 2f10: 20 20 65 72 72 6f 72 20 22 6d 6b 5f 66 69 6c 65 error "mk_file 2f20: 20 24 63 6d 64 3f 22 0a 09 09 7d 0a 09 7d 0a 20 $cmd?"...}..}. 2f30: 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d }.. proc m 2f40: 6b 5f 76 69 65 77 20 7b 63 6d 64 20 70 61 74 68 k_view {cmd path 2f50: 20 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e args} {.#set in 2f60: 64 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 dent [string rep 2f70: 65 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f eat " " [info 2f80: 20 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 level]].#puts s 2f90: 74 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d tderr "${indent} 2fa0: 44 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a DEBUG: readkit:: 2fb0: 76 69 65 77 20 24 63 6d 64 20 24 70 61 74 68 20 view $cmd $path 2fc0: 24 61 72 67 73 22 0a 09 6c 61 73 73 69 67 6e 20 $args"..lassign 2fd0: 24 61 72 67 73 20 61 31 0a 09 73 77 69 74 63 68 $args a1..switch 2fe0: 20 24 63 6d 64 20 7b 0a 09 20 20 20 20 69 6e 66 $cmd {.. inf 2ff0: 6f 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e o {... return 3000: 20 5b 76 6e 61 6d 65 73 20 5b 61 63 63 65 73 73 [vnames [access 3010: 20 24 70 61 74 68 5d 5d 0a 09 09 7d 0a 09 20 20 $path]]...}.. 3020: 20 20 6c 61 79 6f 75 74 20 7b 0a 09 09 20 20 20 layout {... 3030: 20 73 65 74 20 6c 61 79 6f 75 74 20 22 4e 4f 54 set layout "NOT 3040: 59 45 54 22 0a 09 09 20 20 20 20 69 66 20 7b 5b YET"... if {[ 3050: 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 3e llength $args] > 3060: 20 30 20 26 26 20 24 6c 61 79 6f 75 74 20 21 3d 0 && $layout != 3070: 20 24 61 31 7d 20 7b 0a 09 09 09 23 65 72 72 6f $a1} {....#erro 3080: 72 20 22 76 69 65 77 20 72 65 73 74 72 75 63 74 r "view restruct 3090: 75 72 69 6e 67 20 6e 6f 74 20 73 75 70 70 6f 72 uring not suppor 30a0: 74 65 64 22 0a 09 09 20 20 20 20 7d 0a 09 09 20 ted"... }... 30b0: 20 20 20 72 65 74 75 72 6e 20 24 6c 61 79 6f 75 return $layou 30c0: 74 0a 09 09 7d 0a 09 20 20 20 20 73 69 7a 65 20 t...}.. size 30d0: 7b 0a 09 09 20 20 20 20 73 65 74 20 6c 65 6e 20 {... set len 30e0: 5b 76 6c 65 6e 20 5b 61 63 63 65 73 73 20 24 70 [vlen [access $p 30f0: 61 74 68 5d 5d 0a 09 09 20 20 20 20 69 66 20 7b ath]]... if { 3100: 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 [llength $args] 3110: 3e 20 30 20 26 26 20 24 6c 65 6e 20 21 3d 20 24 > 0 && $len != $ 3120: 61 31 7d 20 7b 0a 09 09 09 65 72 72 6f 72 20 22 a1} {....error " 3130: 76 69 65 77 20 72 65 73 69 7a 69 6e 67 20 6e 6f view resizing no 3140: 74 20 73 75 70 70 6f 72 74 65 64 22 0a 09 09 20 t supported"... 3150: 20 20 20 7d 0a 09 09 20 20 20 20 72 65 74 75 72 }... retur 3160: 6e 20 5b 76 6c 65 6e 20 5b 61 63 63 65 73 73 20 n [vlen [access 3170: 24 70 61 74 68 5d 5d 0a 09 09 7d 0a 09 20 20 20 $path]]...}.. 3180: 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 20 20 20 default {... 3190: 20 65 72 72 6f 72 20 22 6d 6b 5f 76 69 65 77 20 error "mk_view 31a0: 24 63 6d 64 3f 22 0a 09 09 7d 0a 09 7d 0a 20 20 $cmd?"...}..}. 31b0: 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6b }.. proc mk 31c0: 5f 63 75 72 73 6f 72 20 7b 63 6d 64 20 63 75 72 _cursor {cmd cur 31d0: 73 6f 72 20 61 72 67 73 7d 20 7b 0a 23 73 65 74 sor args} {.#set 31e0: 20 69 6e 64 65 6e 74 20 5b 73 74 72 69 6e 67 20 indent [string 31f0: 72 65 70 65 61 74 20 22 20 20 20 20 22 20 5b 69 repeat " " [i 3200: 6e 66 6f 20 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 nfo level]].#put 3210: 73 20 73 74 64 65 72 72 20 22 24 7b 69 6e 64 65 s stderr "${inde 3220: 6e 74 7d 44 45 42 55 47 3a 20 72 65 61 64 6b 69 nt}DEBUG: readki 3230: 74 3a 3a 63 75 72 73 6f 72 20 24 63 6d 64 20 24 t::cursor $cmd $ 3240: 63 75 72 73 6f 72 20 24 61 72 67 73 22 0a 09 75 cursor $args"..u 3250: 70 76 61 72 20 24 63 75 72 73 6f 72 20 76 0a 09 pvar $cursor v.. 3260: 73 77 69 74 63 68 20 24 63 6d 64 20 7b 0a 09 20 switch $cmd {.. 3270: 20 20 20 63 72 65 61 74 65 20 7b 0a 09 09 20 20 create {... 3280: 20 20 4e 4f 54 59 45 54 0a 09 09 7d 0a 09 20 20 NOTYET...}.. 3290: 20 20 69 6e 63 72 20 7b 0a 09 09 20 20 20 20 4e incr {... N 32a0: 4f 54 59 45 54 0a 09 09 7d 0a 09 20 20 20 20 70 OTYET...}.. p 32b0: 6f 73 20 2d 0a 09 20 20 20 20 70 6f 73 69 74 69 os -.. positi 32c0: 6f 6e 20 7b 0a 09 09 20 20 20 20 69 66 20 7b 24 on {... if {$ 32d0: 61 72 67 73 20 21 3d 20 22 22 7d 20 7b 0a 09 09 args != ""} {... 32e0: 09 72 65 67 73 75 62 20 7b 21 2d 3f 5c 64 2b 24 .regsub {!-?\d+$ 32f0: 7d 20 24 76 20 7b 7d 20 76 0a 09 09 09 61 70 70 } $v {} v....app 3300: 65 6e 64 20 76 20 21 24 61 72 67 73 0a 09 09 09 end v !$args.... 3310: 72 65 74 75 72 6e 20 24 61 72 67 73 0a 09 09 20 return $args... 3320: 20 20 20 7d 0a 09 09 20 20 20 20 69 66 20 7b 21 }... if {! 3330: 5b 72 65 67 65 78 70 20 7b 5c 64 2b 24 7d 20 24 [regexp {\d+$} $ 3340: 76 20 6e 5d 7d 20 7b 0a 09 09 09 73 65 74 20 6e v n]} {....set n 3350: 20 2d 31 0a 09 09 20 20 20 20 7d 0a 09 09 20 20 -1... }... 3360: 20 20 72 65 74 75 72 6e 20 24 6e 0a 09 09 7d 0a return $n...}. 3370: 09 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a 09 . default {.. 3380: 09 20 20 20 20 65 72 72 6f 72 20 22 6d 6b 5f 63 . error "mk_c 3390: 75 72 73 6f 72 20 24 63 6d 64 3f 22 0a 09 09 7d ursor $cmd?"...} 33a0: 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 ..}. }.. p 33b0: 72 6f 63 20 6d 6b 5f 67 65 74 20 7b 70 61 74 68 roc mk_get {path 33c0: 20 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e args} {.#set in 33d0: 64 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 dent [string rep 33e0: 65 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f eat " " [info 33f0: 20 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 level]].#puts s 3400: 74 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d tderr "${indent} 3410: 44 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a DEBUG: readkit:: 3420: 67 65 74 20 24 70 61 74 68 20 24 61 72 67 73 22 get $path $args" 3430: 0a 09 73 65 74 20 72 6f 77 72 65 66 20 5b 61 63 ..set rowref [ac 3440: 63 65 73 73 20 24 70 61 74 68 5d 0a 09 73 65 74 cess $path]..set 3450: 20 73 69 7a 65 64 20 30 0a 09 69 66 20 7b 5b 6c sized 0..if {[l 3460: 69 6e 64 65 78 20 24 61 72 67 73 20 30 5d 20 3d index $args 0] = 3470: 3d 20 22 2d 73 69 7a 65 22 7d 20 7b 0a 09 20 20 = "-size"} {.. 3480: 20 20 73 65 74 20 73 69 7a 65 64 20 31 0a 09 20 set sized 1.. 3490: 20 20 20 73 65 74 20 61 72 67 73 20 5b 6c 72 61 set args [lra 34a0: 6e 67 65 20 24 61 72 67 73 20 31 20 65 6e 64 5d nge $args 1 end] 34b0: 0a 09 7d 0a 09 73 65 74 20 69 64 73 20 30 0a 09 ..}..set ids 0.. 34c0: 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 72 if {[llength $ar 34d0: 67 73 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 gs] == 0} {.. 34e0: 20 73 65 74 20 61 72 67 73 20 5b 76 6e 61 6d 65 set args [vname 34f0: 73 20 24 72 6f 77 72 65 66 5d 0a 09 20 20 20 20 s $rowref].. 3500: 73 65 74 20 69 64 73 20 31 0a 09 7d 0a 09 73 65 set ids 1..}..se 3510: 74 20 72 20 7b 7d 0a 09 66 6f 72 65 61 63 68 20 t r {}..foreach 3520: 78 20 24 61 72 67 73 20 7b 0a 09 20 20 20 20 69 x $args {.. i 3530: 66 20 7b 24 69 64 73 7d 20 7b 0a 09 09 6c 61 70 f {$ids} {...lap 3540: 70 65 6e 64 20 72 20 24 78 0a 09 20 20 20 20 7d pend r $x.. } 3550: 0a 09 20 20 20 20 73 65 74 20 76 20 5b 6d 76 65 .. set v [mve 3560: 63 20 24 72 6f 77 72 65 66 20 24 78 5d 0a 69 66 c $rowref $x].if 3570: 20 7b 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 {[string range 3580: 24 76 20 30 20 38 5d 20 3d 3d 20 22 67 65 74 5f $v 0 8] == "get_ 3590: 76 69 65 77 20 22 7d 20 7b 0a 23 20 58 58 58 3a view "} {.# XXX: 35a0: 20 3f 21 3f 21 3f 3a 20 54 4f 44 4f 3a 20 46 49 ?!?!?: TODO: FI 35b0: 58 0a 73 65 74 20 76 20 31 0a 7d 0a 09 20 20 20 X.set v 1.}.. 35c0: 20 63 61 74 63 68 20 7b 0a 09 09 73 65 74 20 76 catch {...set v 35d0: 20 5b 7a 6c 69 62 20 64 65 63 6f 6d 70 72 65 73 [zlib decompres 35e0: 73 20 24 76 5d 0a 09 20 20 20 20 7d 0a 09 20 20 s $v].. }.. 35f0: 20 20 69 66 20 7b 24 73 69 7a 65 64 7d 20 7b 0a if {$sized} {. 3600: 09 09 6c 61 70 70 65 6e 64 20 72 20 5b 73 74 72 ..lappend r [str 3610: 69 6e 67 20 6c 65 6e 67 74 68 20 24 76 5d 0a 09 ing length $v].. 3620: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 6c } else {...l 3630: 61 70 70 65 6e 64 20 72 20 24 76 0a 09 20 20 20 append r $v.. 3640: 20 7d 0a 09 7d 0a 09 69 66 20 7b 5b 6c 6c 65 6e }..}..if {[llen 3650: 67 74 68 20 24 61 72 67 73 5d 20 3d 3d 20 31 7d gth $args] == 1} 3660: 20 7b 0a 09 20 20 20 20 73 65 74 20 72 20 5b 6c {.. set r [l 3670: 69 6e 64 65 78 20 24 72 20 30 5d 0a 09 7d 0a 0a index $r 0]..}.. 3680: 09 72 65 74 75 72 6e 20 24 72 0a 20 20 20 20 7d .return $r. } 3690: 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6b 5f 6c 6f .. proc mk_lo 36a0: 6f 70 20 7b 63 75 72 73 6f 72 20 70 61 74 68 20 op {cursor path 36b0: 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e 64 args} {.#set ind 36c0: 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 65 ent [string repe 36d0: 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f 20 at " " [info 36e0: 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74 level]].#puts st 36f0: 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44 derr "${indent}D 3700: 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a 6c EBUG: readkit::l 3710: 6f 6f 70 20 24 63 75 72 73 6f 72 20 24 70 61 74 oop $cursor $pat 3720: 68 20 2e 2e 2e 22 0a 09 75 70 76 61 72 20 24 63 h ..."..upvar $c 3730: 75 72 73 6f 72 20 76 0a 09 69 66 20 7b 5b 6c 6c ursor v..if {[ll 3740: 65 6e 67 74 68 20 24 61 72 67 73 5d 20 3d 3d 20 ength $args] == 3750: 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 61 72 0} {.. set ar 3760: 67 73 20 5b 6c 69 73 74 20 24 70 61 74 68 5d 0a gs [list $path]. 3770: 09 20 20 20 20 73 65 74 20 70 61 74 68 20 24 76 . set path $v 3780: 0a 09 20 20 20 20 72 65 67 73 75 62 20 7b 21 2d .. regsub {!- 3790: 3f 5c 64 2b 24 7d 20 24 70 61 74 68 20 7b 7d 20 ?\d+$} $path {} 37a0: 70 61 74 68 0a 09 7d 0a 09 6c 61 73 73 69 67 6e path..}..lassign 37b0: 20 24 61 72 67 73 20 61 31 20 61 32 20 61 33 20 $args a1 a2 a3 37c0: 61 34 0a 09 73 65 74 20 72 6f 77 72 65 66 20 5b a4..set rowref [ 37d0: 61 63 63 65 73 73 20 24 70 61 74 68 5d 0a 09 73 access $path]..s 37e0: 65 74 20 66 69 72 73 74 20 30 0a 09 73 65 74 20 et first 0..set 37f0: 6c 69 6d 69 74 20 5b 76 6c 65 6e 20 24 72 6f 77 limit [vlen $row 3800: 72 65 66 5d 0a 09 73 65 74 20 73 74 65 70 20 31 ref]..set step 1 3810: 0a 09 73 77 69 74 63 68 20 5b 6c 6c 65 6e 67 74 ..switch [llengt 3820: 68 20 24 61 72 67 73 5d 20 7b 0a 09 20 20 20 20 h $args] {.. 3830: 31 20 7b 0a 09 09 20 20 20 20 73 65 74 20 62 6f 1 {... set bo 3840: 64 79 20 24 61 31 0a 09 09 7d 0a 09 20 20 20 20 dy $a1...}.. 3850: 32 20 7b 0a 09 09 20 20 20 20 73 65 74 20 66 69 2 {... set fi 3860: 72 73 74 20 24 61 31 0a 09 09 20 20 20 20 73 65 rst $a1... se 3870: 74 20 62 6f 64 79 20 24 61 32 0a 09 09 7d 0a 09 t body $a2...}.. 3880: 20 20 20 20 33 20 7b 0a 09 09 20 20 20 20 73 65 3 {... se 3890: 74 20 66 69 72 73 74 20 24 61 31 0a 09 09 20 20 t first $a1... 38a0: 20 20 73 65 74 20 6c 69 6d 69 74 20 24 61 32 0a set limit $a2. 38b0: 09 09 20 20 20 20 73 65 74 20 62 6f 64 79 20 24 .. set body $ 38c0: 61 33 0a 09 09 7d 0a 09 20 20 20 20 34 20 7b 0a a3...}.. 4 {. 38d0: 09 09 20 20 20 20 73 65 74 20 66 69 72 73 74 20 .. set first 38e0: 24 61 31 0a 09 09 20 20 20 20 73 65 74 20 6c 69 $a1... set li 38f0: 6d 69 74 20 24 61 32 0a 09 09 20 20 20 20 73 65 mit $a2... se 3900: 74 20 73 74 65 70 20 24 61 33 0a 09 09 20 20 20 t step $a3... 3910: 20 73 65 74 20 62 6f 64 79 20 24 61 34 0a 09 09 set body $a4... 3920: 7d 0a 09 20 20 20 20 64 65 66 61 75 6c 74 20 7b }.. default { 3930: 0a 09 09 20 20 20 20 65 72 72 6f 72 20 22 6d 6b ... error "mk 3940: 5f 6c 6f 6f 70 20 61 72 67 20 63 6f 75 6e 74 3f _loop arg count? 3950: 22 0a 09 09 7d 0a 09 7d 0a 09 73 65 74 20 63 6f "...}..}..set co 3960: 64 65 20 30 0a 09 66 6f 72 20 7b 73 65 74 20 69 de 0..for {set i 3970: 20 24 66 69 72 73 74 7d 20 7b 24 69 20 3c 20 24 $first} {$i < $ 3980: 6c 69 6d 69 74 7d 20 7b 69 6e 63 72 20 69 20 24 limit} {incr i $ 3990: 73 74 65 70 7d 20 7b 0a 09 20 20 20 20 73 65 74 step} {.. set 39a0: 20 76 20 24 70 61 74 68 21 24 69 0a 09 20 20 20 v $path!$i.. 39b0: 20 73 65 74 20 63 6f 64 65 20 5b 63 61 74 63 68 set code [catch 39c0: 20 5b 6c 69 73 74 20 75 70 6c 65 76 65 6c 20 31 [list uplevel 1 39d0: 20 24 62 6f 64 79 5d 20 65 72 72 5d 0a 09 20 20 $body] err].. 39e0: 20 20 73 77 69 74 63 68 20 24 63 6f 64 65 20 7b switch $code { 39f0: 0a 09 09 31 20 2d 0a 09 09 32 20 7b 0a 09 09 09 ...1 -...2 {.... 3a00: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 24 63 6f return -code $co 3a10: 64 65 20 24 65 72 72 0a 09 09 20 20 20 20 7d 0a de $err... }. 3a20: 09 09 33 20 7b 0a 09 09 09 62 72 65 61 6b 0a 09 ..3 {....break.. 3a30: 09 20 20 20 20 7d 0a 09 20 20 20 20 7d 0a 09 7d . }.. }..} 3a40: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 . }.. proc 3a50: 20 6d 6b 5f 73 65 6c 65 63 74 20 7b 70 61 74 68 mk_select {path 3a60: 20 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e args} {.#set in 3a70: 64 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 dent [string rep 3a80: 65 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f eat " " [info 3a90: 20 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 level]].#puts s 3aa0: 74 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d tderr "${indent} 3ab0: 44 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a DEBUG: readkit:: 3ac0: 73 65 6c 65 63 74 20 24 70 61 74 68 20 24 61 72 select $path $ar 3ad0: 67 73 22 0a 09 23 20 6f 6e 6c 79 20 68 61 6e 64 gs"..# only hand 3ae0: 6c 65 20 74 68 65 20 73 69 6d 70 6c 65 73 74 20 le the simplest 3af0: 63 61 73 65 3a 20 65 78 61 63 74 20 6d 61 74 63 case: exact matc 3b00: 68 65 73 0a 09 69 66 20 7b 5b 6c 69 6e 64 65 78 hes..if {[lindex 3b10: 20 24 61 72 67 73 20 30 5d 20 3d 3d 20 22 2d 63 $args 0] == "-c 3b20: 6f 75 6e 74 22 7d 20 7b 0a 09 09 73 65 74 20 6d ount"} {...set m 3b30: 61 78 69 74 65 6d 73 20 5b 6c 69 6e 64 65 78 20 axitems [lindex 3b40: 24 61 72 67 73 20 31 5d 0a 09 09 73 65 74 20 61 $args 1]...set a 3b50: 72 67 73 20 5b 6c 72 61 6e 67 65 20 24 61 72 67 rgs [lrange $arg 3b60: 73 20 32 20 65 6e 64 5d 0a 09 7d 0a 0a 09 73 65 s 2 end]..}...se 3b70: 74 20 63 75 72 72 6d 61 74 63 68 6d 6f 64 65 20 t currmatchmode 3b80: 22 63 61 73 65 69 6e 73 65 6e 73 69 74 69 76 65 "caseinsensitive 3b90: 22 0a 0a 09 73 65 74 20 6b 65 79 73 20 7b 7d 0a "...set keys {}. 3ba0: 09 73 65 74 20 76 61 6c 75 65 20 7b 7d 0a 09 73 .set value {}..s 3bb0: 65 74 20 6d 61 74 63 68 6d 6f 64 65 73 20 7b 7d et matchmodes {} 3bc0: 0a 09 66 6f 72 20 7b 73 65 74 20 69 64 78 20 30 ..for {set idx 0 3bd0: 7d 20 7b 24 69 64 78 20 3c 20 5b 6c 6c 65 6e 67 } {$idx < [lleng 3be0: 74 68 20 24 61 72 67 73 5d 7d 20 7b 69 6e 63 72 th $args]} {incr 3bf0: 20 69 64 78 20 32 7d 20 7b 0a 09 09 73 77 69 74 idx 2} {...swit 3c00: 63 68 20 2d 67 6c 6f 62 20 2d 2d 20 5b 6c 69 6e ch -glob -- [lin 3c10: 64 65 78 20 24 61 72 67 73 20 24 69 64 78 5d 20 dex $args $idx] 3c20: 7b 0a 09 09 09 22 2d 67 6c 6f 62 22 20 7b 0a 09 {...."-glob" {.. 3c30: 09 09 09 73 65 74 20 63 75 72 72 6d 61 74 63 68 ...set currmatch 3c40: 6d 6f 64 65 20 22 67 6c 6f 62 22 0a 09 09 09 09 mode "glob"..... 3c50: 69 6e 63 72 20 69 64 78 20 2d 31 0a 09 09 09 09 incr idx -1..... 3c60: 63 6f 6e 74 69 6e 75 65 0a 09 09 09 7d 0a 09 09 continue....}... 3c70: 09 22 2d 2a 22 20 7b 0a 09 09 09 09 65 72 72 6f ."-*" {.....erro 3c80: 72 20 22 55 6e 68 61 6e 64 6c 65 64 20 6f 70 74 r "Unhandled opt 3c90: 69 6f 6e 3a 20 5b 6c 69 6e 64 65 78 20 24 61 72 ion: [lindex $ar 3ca0: 67 73 20 24 69 64 78 5d 22 0a 09 09 09 7d 0a 09 gs $idx]"....}.. 3cb0: 09 7d 0a 0a 09 09 73 65 74 20 6b 20 5b 6c 69 6e .}....set k [lin 3cc0: 64 65 78 20 24 61 72 67 73 20 24 69 64 78 5d 0a dex $args $idx]. 3cd0: 09 09 73 65 74 20 76 20 5b 6c 69 6e 64 65 78 20 ..set v [lindex 3ce0: 24 61 72 67 73 20 5b 65 78 70 72 20 7b 24 69 64 $args [expr {$id 3cf0: 78 2b 31 7d 5d 5d 0a 0a 09 09 6c 61 70 70 65 6e x+1}]]....lappen 3d00: 64 20 6b 65 79 73 20 24 6b 0a 09 09 6c 61 70 70 d keys $k...lapp 3d10: 65 6e 64 20 76 61 6c 75 65 73 20 24 76 0a 09 09 end values $v... 3d20: 6c 61 70 70 65 6e 64 20 6d 61 74 63 68 6d 6f 64 lappend matchmod 3d30: 65 73 20 24 63 75 72 72 6d 61 74 63 68 6d 6f 64 es $currmatchmod 3d40: 65 0a 09 7d 0a 09 73 65 74 20 72 20 7b 7d 0a 09 e..}..set r {}.. 3d50: 6d 6b 5f 6c 6f 6f 70 20 63 20 24 70 61 74 68 20 mk_loop c $path 3d60: 7b 0a 09 09 73 65 74 20 78 20 5b 65 76 61 6c 20 {...set x [eval 3d70: 6d 6b 5f 67 65 74 20 24 63 20 24 6b 65 79 73 5d mk_get $c $keys] 3d80: 0a 09 09 73 65 74 20 6d 61 74 63 68 43 6e 74 20 ...set matchCnt 3d90: 30 0a 09 09 66 6f 72 20 7b 73 65 74 20 69 64 78 0...for {set idx 3da0: 20 30 7d 20 7b 24 69 64 78 20 3c 20 5b 6c 6c 65 0} {$idx < [lle 3db0: 6e 67 74 68 20 24 78 5d 7d 20 7b 69 6e 63 72 20 ngth $x]} {incr 3dc0: 69 64 78 7d 20 7b 0a 09 09 09 73 65 74 20 76 61 idx} {....set va 3dd0: 6c 20 5b 6c 69 6e 64 65 78 20 24 76 61 6c 75 65 l [lindex $value 3de0: 73 20 24 69 64 78 5d 0a 09 09 09 73 65 74 20 63 s $idx]....set c 3df0: 68 6b 76 61 6c 20 5b 6c 69 6e 64 65 78 20 24 78 hkval [lindex $x 3e00: 20 24 69 64 78 5d 0a 09 09 09 73 65 74 20 6d 61 $idx]....set ma 3e10: 74 63 68 6d 6f 64 65 20 5b 6c 69 6e 64 65 78 20 tchmode [lindex 3e20: 24 6d 61 74 63 68 6d 6f 64 65 73 20 24 69 64 78 $matchmodes $idx 3e30: 5d 0a 0a 09 09 09 73 77 69 74 63 68 20 2d 2d 20 ].....switch -- 3e40: 24 6d 61 74 63 68 6d 6f 64 65 20 7b 0a 09 09 09 $matchmode {.... 3e50: 09 22 63 61 73 65 69 6e 73 65 6e 73 69 74 69 76 ."caseinsensitiv 3e60: 65 22 20 7b 0a 09 09 09 09 09 69 66 20 7b 24 76 e" {......if {$v 3e70: 61 6c 20 3d 3d 20 24 63 68 6b 76 61 6c 7d 20 7b al == $chkval} { 3e80: 0a 09 09 09 09 09 09 69 6e 63 72 20 6d 61 74 63 .......incr matc 3e90: 68 43 6e 74 0a 09 09 09 09 09 7d 0a 09 09 09 09 hCnt......}..... 3ea0: 7d 0a 09 09 09 09 22 67 6c 6f 62 22 20 7b 0a 09 }....."glob" {.. 3eb0: 09 09 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 ....if {[string 3ec0: 6d 61 74 63 68 20 24 76 61 6c 20 24 63 68 6b 76 match $val $chkv 3ed0: 61 6c 5d 7d 20 7b 0a 09 09 09 09 09 09 69 6e 63 al]} {.......inc 3ee0: 72 20 6d 61 74 63 68 43 6e 74 0a 09 09 09 09 09 r matchCnt...... 3ef0: 7d 0a 09 09 09 09 7d 0a 09 09 09 7d 0a 0a 09 09 }.....}....}.... 3f00: 7d 0a 09 09 69 66 20 7b 24 6d 61 74 63 68 43 6e }...if {$matchCn 3f10: 74 20 3d 3d 20 5b 6c 6c 65 6e 67 74 68 20 24 6b t == [llength $k 3f20: 65 79 73 5d 7d 20 7b 0a 09 09 09 6c 61 70 70 65 eys]} {....lappe 3f30: 6e 64 20 72 20 5b 6d 6b 5f 63 75 72 73 6f 72 20 nd r [mk_cursor 3f40: 70 6f 73 69 74 69 6f 6e 20 63 5d 0a 09 09 7d 0a position c]...}. 3f50: 09 7d 0a 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65 .}...if {[info e 3f60: 78 69 73 74 73 20 6d 61 78 69 74 65 6d 73 5d 7d xists maxitems]} 3f70: 20 7b 0a 09 09 73 65 74 20 72 20 5b 6c 72 61 6e {...set r [lran 3f80: 67 65 20 24 72 20 30 20 5b 65 78 70 72 20 24 6d ge $r 0 [expr $m 3f90: 61 78 69 74 65 6d 73 20 2d 20 31 5d 5d 0a 09 7d axitems - 1]]..} 3fa0: 0a 0a 09 72 65 74 75 72 6e 20 24 72 0a 20 20 20 ...return $r. 3fb0: 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6b 5f }.. proc mk_ 3fc0: 5f 72 65 63 68 61 6e 20 7b 70 61 74 68 20 70 72 _rechan {path pr 3fd0: 6f 70 20 63 6d 64 20 63 68 61 6e 20 61 72 67 73 op cmd chan args 3fe0: 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20 } {.#set indent 3ff0: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 22 [string repeat " 4000: 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65 " [info leve 4010: 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72 l]].#puts stderr 4020: 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47 "${indent}DEBUG 4030: 3a 20 72 65 61 64 6b 69 74 3a 3a 5f 72 65 63 68 : readkit::_rech 4040: 61 6e 20 24 70 61 74 68 20 24 70 72 6f 70 20 24 an $path $prop $ 4050: 63 6d 64 20 24 63 68 61 6e 20 24 61 72 67 73 22 cmd $chan $args" 4060: 0a 0a 20 20 20 20 20 20 20 20 73 65 74 20 6b 65 .. set ke 4070: 79 20 5b 6c 69 73 74 20 24 70 61 74 68 20 24 70 y [list $path $p 4080: 72 6f 70 5d 0a 20 20 20 20 20 20 20 20 69 66 20 rop]. if 4090: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 3a {![info exists : 40a0: 3a 6d 6b 5f 5f 63 61 63 68 65 28 24 6b 65 79 29 :mk__cache($key) 40b0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 73 ]} {. s 40c0: 65 74 20 3a 3a 6d 6b 5f 5f 63 61 63 68 65 28 24 et ::mk__cache($ 40d0: 6b 65 79 29 20 5b 72 65 61 64 6b 69 74 3a 3a 67 key) [readkit::g 40e0: 65 74 20 24 70 61 74 68 20 24 70 72 6f 70 5d 0a et $path $prop]. 40f0: 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 }. 4100: 20 20 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 if {![info exi 4110: 73 74 73 20 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 74 sts ::mk__offset 4120: 28 24 6b 65 79 29 5d 7d 20 7b 0a 20 20 20 20 20 ($key)]} {. 4130: 20 20 20 20 20 73 65 74 20 3a 3a 6d 6b 5f 5f 6f set ::mk__o 4140: 66 66 73 65 74 28 24 6b 65 79 29 20 30 0a 20 20 ffset($key) 0. 4150: 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 }. 4160: 73 65 74 20 64 61 74 61 20 24 3a 3a 6d 6b 5f 5f set data $::mk__ 4170: 63 61 63 68 65 28 24 6b 65 79 29 0a 20 20 20 20 cache($key). 4180: 20 20 20 20 73 65 74 20 6f 66 66 73 65 74 20 24 set offset $ 4190: 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 74 28 24 6b 65 ::mk__offset($ke 41a0: 79 29 0a 0a 20 20 20 20 20 20 20 20 73 77 69 74 y).. swit 41b0: 63 68 20 2d 2d 20 24 63 6d 64 20 7b 0a 20 20 20 ch -- $cmd {. 41c0: 20 20 20 20 20 20 20 20 20 22 72 65 61 64 22 20 "read" 41d0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {. 41e0: 20 20 73 65 74 20 63 6f 75 6e 74 20 5b 6c 69 6e set count [lin 41f0: 64 65 78 20 24 61 72 67 73 20 30 5d 0a 20 20 20 dex $args 0]. 4200: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set 4210: 20 72 65 74 76 61 6c 20 5b 73 74 72 69 6e 67 20 retval [string 4220: 72 61 6e 67 65 20 24 64 61 74 61 20 24 6f 66 66 range $data $off 4230: 73 65 74 20 5b 65 78 70 72 20 7b 24 6f 66 66 73 set [expr {$offs 4240: 65 74 20 2b 20 24 63 6f 75 6e 74 20 2d 20 31 7d et + $count - 1} 4250: 5d 5d 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 ]].. 4260: 20 20 20 20 73 65 74 20 72 65 61 64 62 79 74 65 set readbyte 4270: 73 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 s [string length 4280: 20 24 72 65 74 76 61 6c 5d 0a 0a 20 20 20 20 20 $retval].. 4290: 20 20 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 incr 42a0: 6f 66 66 73 65 74 20 24 72 65 61 64 62 79 74 65 offset $readbyte 42b0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a s. }. 42c0: 20 20 20 20 20 20 20 20 20 20 20 20 22 63 6c 6f "clo 42d0: 73 65 22 20 7b 0a 20 20 20 20 20 20 20 20 20 20 se" {. 42e0: 20 20 20 20 20 20 75 6e 73 65 74 20 2d 6e 6f 63 unset -noc 42f0: 6f 6d 70 6c 61 69 6e 20 3a 3a 6d 6b 5f 5f 63 61 omplain ::mk__ca 4300: 63 68 65 28 24 6b 65 79 29 0a 20 20 20 20 20 20 che($key). 4310: 20 20 20 20 20 20 20 20 20 20 75 6e 73 65 74 20 unset 4320: 2d 6e 6f 63 6f 6d 70 6c 61 69 6e 20 3a 3a 6d 6b -nocomplain ::mk 4330: 5f 5f 6f 66 66 73 65 74 28 24 6b 65 79 29 0a 20 __offset($key). 4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r 4350: 65 74 75 72 6e 0a 20 20 20 20 20 20 20 20 20 20 eturn. 4360: 20 20 7d 0a 20 20 20 20 20 20 20 20 20 20 20 20 }. 4370: 64 65 66 61 75 6c 74 20 7b 0a 23 70 75 74 73 20 default {.#puts 4380: 73 74 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 stderr "${indent 4390: 7d 44 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a }DEBUG: readkit: 43a0: 3a 5f 72 65 63 68 61 6e 3a 20 43 61 6c 6c 65 64 :_rechan: Called 43b0: 20 66 6f 72 20 63 6d 64 20 24 63 6d 64 22 0a 20 for cmd $cmd". 43c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r 43d0: 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f eturn -code erro 43e0: 72 20 22 4e 6f 74 20 69 6d 70 6c 65 6d 65 6e 74 r "Not implement 43f0: 65 64 3a 20 63 6d 64 20 3d 20 24 63 6d 64 22 0a ed: cmd = $cmd". 4400: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 }. 4410: 20 20 20 20 20 20 7d 0a 0a 20 20 20 20 20 20 20 }.. 4420: 20 73 65 74 20 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 set ::mk__offse 4430: 74 28 24 6b 65 79 29 20 24 6f 66 66 73 65 74 0a t($key) $offset. 4440: 0a 09 72 65 74 75 72 6e 20 24 72 65 74 76 61 6c ..return $retval 4450: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 . }.. proc 4460: 20 6d 6b 5f 63 68 61 6e 6e 65 6c 20 7b 70 61 74 mk_channel {pat 4470: 68 20 70 72 6f 70 20 7b 6d 6f 64 65 20 22 72 22 h prop {mode "r" 4480: 7d 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 }} {.#set indent 4490: 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 [string repeat 44a0: 22 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 " " [info lev 44b0: 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 el]].#puts stder 44c0: 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 r "${indent}DEBU 44d0: 47 3a 20 72 65 61 64 6b 69 74 3a 3a 63 68 61 6e G: readkit::chan 44e0: 6e 65 6c 20 24 70 61 74 68 20 24 70 72 6f 70 20 nel $path $prop 44f0: 24 6d 6f 64 65 22 0a 09 73 65 74 20 66 64 20 5b $mode"..set fd [ 4500: 72 65 63 68 61 6e 20 5b 6c 69 73 74 20 6d 6b 5f rechan [list mk_ 4510: 5f 72 65 63 68 61 6e 20 24 70 61 74 68 20 24 70 _rechan $path $p 4520: 72 6f 70 5d 20 32 5d 0a 0a 09 72 65 74 75 72 6e rop] 2]...return 4530: 20 24 66 64 0a 20 20 20 20 7d 0a 20 20 20 20 23 $fd. }. # 4540: 20 76 69 6d 3a 20 66 74 3d 74 63 6c 0a 0a 7d 0a vim: ft=tcl..}. 4550: 0a 23 20 73 65 74 20 75 70 20 74 68 65 20 4d 65 .# set up the Me 4560: 74 61 4b 69 74 20 63 6f 6d 70 61 74 69 62 69 6c taKit compatibil 4570: 69 74 79 20 64 65 66 69 6e 69 74 69 6f 6e 73 0a ity definitions. 4580: 66 6f 72 65 61 63 68 20 78 20 7b 66 69 6c 65 20 foreach x {file 4590: 76 69 65 77 20 63 75 72 73 6f 72 20 67 65 74 20 view cursor get 45a0: 6c 6f 6f 70 20 73 65 6c 65 63 74 20 63 68 61 6e loop select chan 45b0: 6e 65 6c 7d 20 7b 0a 20 20 20 20 69 6e 74 65 72 nel} {. inter 45c0: 70 20 61 6c 69 61 73 20 7b 7d 20 3a 3a 72 65 61 p alias {} ::rea 45d0: 64 6b 69 74 3a 3a 24 78 20 7b 7d 20 3a 3a 6d 6b dkit::$x {} ::mk 45e0: 5f 24 78 0a 7d 0a 0a 0a 0a 23 20 6d 6b 34 76 66 _$x.}....# mk4vf 45f0: 73 2e 74 63 6c 20 2d 2d 20 4d 6b 34 74 63 6c 20 s.tcl -- Mk4tcl 4600: 56 69 72 74 75 61 6c 20 46 69 6c 65 20 53 79 73 Virtual File Sys 4610: 74 65 6d 20 64 72 69 76 65 72 0a 23 20 43 6f 70 tem driver.# Cop 4620: 79 72 69 67 68 74 20 28 43 29 20 31 39 39 37 2d yright (C) 1997- 4630: 32 30 30 33 20 53 65 6e 73 75 73 20 43 6f 6e 73 2003 Sensus Cons 4640: 75 6c 74 69 6e 67 20 4c 74 64 2e 20 41 6c 6c 20 ulting Ltd. All 4650: 52 69 67 68 74 73 20 52 65 73 65 72 76 65 64 2e Rights Reserved. 4660: 0a 23 20 4d 61 74 74 20 4e 65 77 6d 61 6e 20 3c .# Matt Newman < 4670: 6d 61 74 74 40 73 65 6e 73 75 73 2e 6f 72 67 3e matt@sensus.org> 4680: 20 61 6e 64 20 4a 65 61 6e 2d 43 6c 61 75 64 65 and Jean-Claude 4690: 20 57 69 70 70 6c 65 72 20 3c 6a 63 77 40 65 71 Wippler <jcw@eq 46a0: 75 69 34 2e 63 6f 6d 3e 0a 23 0a 23 20 24 49 64 ui4.com>.#.# $Id 46b0: 3a 20 6d 6b 34 76 66 73 2e 74 63 6c 2c 76 20 31 : mk4vfs.tcl,v 1 46c0: 2e 34 31 20 32 30 30 38 2f 30 34 2f 31 35 20 32 .41 2008/04/15 2 46d0: 31 3a 31 31 3a 35 33 20 61 6e 64 72 65 61 73 5f 1:11:53 andreas_ 46e0: 6b 75 70 72 69 65 73 20 45 78 70 20 24 0a 23 0a kupries Exp $.#. 46f0: 23 20 30 35 61 70 72 30 32 20 6a 63 77 09 31 2e # 05apr02 jcw.1. 4700: 33 09 66 69 78 65 64 20 61 70 70 65 6e 64 20 6d 3.fixed append m 4710: 6f 64 65 20 26 20 63 6c 6f 73 65 2c 0a 23 09 09 ode & close,.#.. 4720: 09 70 72 69 76 61 74 69 7a 65 64 20 6d 65 6d 63 .privatized memc 4730: 68 61 6e 5f 68 61 6e 64 6c 65 72 0a 23 09 09 09 han_handler.#... 4740: 61 64 64 65 64 20 7a 69 70 2c 20 63 72 63 20 62 added zip, crc b 4750: 61 63 6b 20 69 6e 0a 23 20 32 38 61 70 72 30 32 ack in.# 28apr02 4760: 20 6a 63 77 09 31 2e 34 09 72 65 6f 72 67 65 64 jcw.1.4.reorged 4770: 20 6d 65 6d 63 68 61 6e 20 61 6e 64 20 70 6b 67 memchan and pkg 4780: 20 64 65 70 65 6e 64 65 6e 63 69 65 73 0a 23 20 dependencies.# 4790: 32 32 6a 75 6e 30 32 20 6a 63 77 09 31 2e 35 09 22jun02 jcw.1.5. 47a0: 66 69 78 65 64 20 72 65 63 75 72 73 69 76 65 20 fixed recursive 47b0: 64 69 72 20 64 65 6c 65 74 69 6f 6e 0a 23 20 31 dir deletion.# 1 47c0: 36 6f 63 74 30 32 20 6a 63 77 09 31 2e 36 09 66 6oct02 jcw.1.6.f 47d0: 69 78 65 64 20 70 65 72 69 6f 64 69 63 20 63 6f ixed periodic co 47e0: 6d 6d 69 74 20 6f 6e 63 65 20 61 20 63 68 61 6e mmit once a chan 47f0: 67 65 20 69 73 20 6d 61 64 65 0a 23 20 32 30 6a ge is made.# 20j 4800: 61 6e 30 33 20 6a 63 77 09 31 2e 37 09 73 74 72 an03 jcw.1.7.str 4810: 65 61 6d 65 64 20 7a 6c 69 62 20 64 65 63 6f 6d eamed zlib decom 4820: 70 72 65 73 73 20 6d 6f 64 65 2c 20 72 65 64 75 press mode, redu 4830: 63 65 73 20 6d 65 6d 6f 72 79 20 75 73 61 67 65 ces memory usage 4840: 0a 23 20 30 31 66 65 62 30 33 20 6a 63 77 09 31 .# 01feb03 jcw.1 4850: 2e 38 09 66 69 78 20 6d 6f 75 6e 74 69 6e 67 20 .8.fix mounting 4860: 61 20 73 79 6d 6c 69 6e 6b 2c 20 63 6c 65 61 6e a symlink, clean 4870: 75 70 20 6d 6f 75 6e 74 2f 75 6e 6d 6f 75 6e 74 up mount/unmount 4880: 20 70 72 6f 63 73 0a 23 20 30 34 66 65 62 30 33 procs.# 04feb03 4890: 20 6a 63 77 09 31 2e 38 09 77 68 6f 6f 70 73 2c jcw.1.8.whoops, 48a0: 20 72 65 73 74 6f 72 65 64 20 76 66 73 3a 3a 6d restored vfs::m 48b0: 6b 63 6c 3a 3a 55 6e 6d 6f 75 6e 74 20 6c 6f 67 kcl::Unmount log 48c0: 69 63 0a 23 20 31 37 6d 61 72 30 33 20 6a 63 77 ic.# 17mar03 jcw 48d0: 09 31 2e 39 09 73 74 61 72 74 20 77 69 74 68 20 .1.9.start with 48e0: 6d 6f 64 65 20 74 72 61 6e 73 6c 75 63 65 6e 74 mode translucent 48f0: 20 6f 72 20 72 65 61 64 77 72 69 74 65 0a 23 20 or readwrite.# 4900: 31 38 6f 63 74 30 35 20 6a 63 77 09 31 2e 31 30 18oct05 jcw.1.10 4910: 09 61 64 64 20 66 61 6c 6c 62 61 63 6b 20 74 6f .add fallback to 4920: 20 4d 4b 20 43 6f 6d 70 61 74 69 62 6c 65 20 4c MK Compatible L 4930: 69 74 65 20 64 72 69 76 65 72 20 28 76 66 73 3a ite driver (vfs: 4940: 3a 6d 6b 63 6c 29 0a 0a 23 20 52 65 6d 6f 76 65 :mkcl)..# Remove 4950: 64 20 70 72 6f 76 69 73 69 6f 6e 20 6f 66 20 74 d provision of t 4960: 68 65 20 62 61 63 6b 77 61 72 64 20 63 6f 6d 70 he backward comp 4970: 61 74 69 62 6c 65 20 6e 61 6d 65 2e 20 4d 6f 76 atible name. Mov 4980: 65 64 20 74 6f 20 73 65 70 61 72 61 74 65 0a 23 ed to separate.# 4990: 20 66 69 6c 65 2f 70 61 63 6b 61 67 65 2e 0a 63 file/package..c 49a0: 61 74 63 68 20 7b 0a 09 6c 6f 61 64 20 7b 7d 20 atch {..load {} 49b0: 76 66 73 0a 7d 0a 70 61 63 6b 61 67 65 20 72 65 vfs.}.package re 49c0: 71 75 69 72 65 20 76 66 73 0a 0a 23 20 74 68 69 quire vfs..# thi 49d0: 6e 67 73 20 74 68 61 74 20 63 61 6e 20 6e 6f 20 ngs that can no 49e0: 6c 6f 6e 67 65 72 20 72 65 61 6c 6c 79 20 62 65 longer really be 49f0: 20 6c 65 66 74 20 6f 75 74 20 28 62 75 74 20 74 left out (but t 4a00: 68 69 73 20 69 73 20 74 68 65 20 77 72 6f 6e 67 his is the wrong 4a10: 20 73 70 6f 74 21 29 0a 23 20 62 65 20 61 73 20 spot!).# be as 4a20: 6e 6f 6e 2d 69 6e 76 61 73 69 76 65 20 61 73 20 non-invasive as 4a30: 70 6f 73 73 69 62 6c 65 2c 20 75 73 69 6e 67 20 possible, using 4a40: 74 68 65 73 65 20 64 65 66 69 6e 69 74 69 6f 6e these definition 4a50: 73 20 61 73 20 6c 61 73 74 20 72 65 73 6f 72 74 s as last resort 4a60: 0a 0a 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c ..namespace eval 4a70: 20 76 66 73 3a 3a 6d 6b 63 6c 20 7b 0a 20 20 20 vfs::mkcl {. 4a80: 20 70 72 6f 63 20 4d 6f 75 6e 74 20 7b 6d 6b 66 proc Mount {mkf 4a90: 69 6c 65 20 6c 6f 63 61 6c 20 61 72 67 73 7d 20 ile local args} 4aa0: 7b 0a 09 69 66 20 7b 24 6d 6b 66 69 6c 65 20 21 {..if {$mkfile ! 4ab0: 3d 20 22 22 7d 20 7b 0a 09 20 20 23 20 64 65 72 = ""} {.. # der 4ac0: 65 66 65 72 65 6e 63 65 20 61 20 73 79 6d 6c 69 eference a symli 4ad0: 6e 6b 2c 20 6f 74 68 65 72 77 69 73 65 20 6d 6f nk, otherwise mo 4ae0: 75 6e 74 69 6e 67 20 6f 6e 20 69 74 20 66 61 69 unting on it fai 4af0: 6c 73 20 28 77 68 79 3f 29 0a 09 20 20 63 61 74 ls (why?).. cat 4b00: 63 68 20 7b 0a 09 20 20 20 20 73 65 74 20 6d 6b ch {.. set mk 4b10: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join 4b20: 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 24 6d [file dirname $m 4b30: 6b 66 69 6c 65 5d 20 5c 0a 09 20 20 20 20 09 09 kfile] \.. .. 4b40: 09 20 20 5b 66 69 6c 65 20 72 65 61 64 6c 69 6e . [file readlin 4b50: 6b 20 24 6d 6b 66 69 6c 65 5d 5d 0a 09 20 20 7d k $mkfile]].. } 4b60: 0a 09 20 20 73 65 74 20 6d 6b 66 69 6c 65 20 5b .. set mkfile [ 4b70: 66 69 6c 65 20 6e 6f 72 6d 61 6c 69 7a 65 20 24 file normalize $ 4b80: 6d 6b 66 69 6c 65 5d 0a 09 7d 0a 09 73 65 74 20 mkfile]..}..set 4b90: 64 62 20 5b 65 76 61 6c 20 5b 6c 69 73 74 20 3a db [eval [list : 4ba0: 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 5f 6d 6f 75 6e :mkcl_vfs::_moun 4bb0: 74 20 24 6d 6b 66 69 6c 65 5d 20 24 61 72 67 73 t $mkfile] $args 4bc0: 5d 0a 09 3a 3a 76 66 73 3a 3a 66 69 6c 65 73 79 ]..::vfs::filesy 4bd0: 73 74 65 6d 20 6d 6f 75 6e 74 20 24 6c 6f 63 61 stem mount $loca 4be0: 6c 20 5b 6c 69 73 74 20 3a 3a 76 66 73 3a 3a 6d l [list ::vfs::m 4bf0: 6b 63 6c 3a 3a 68 61 6e 64 6c 65 72 20 24 64 62 kcl::handler $db 4c00: 5d 0a 09 3a 3a 76 66 73 3a 3a 52 65 67 69 73 74 ]..::vfs::Regist 4c10: 65 72 4d 6f 75 6e 74 20 24 6c 6f 63 61 6c 20 5b erMount $local [ 4c20: 6c 69 73 74 20 3a 3a 76 66 73 3a 3a 6d 6b 63 6c list ::vfs::mkcl 4c30: 3a 3a 55 6e 6d 6f 75 6e 74 20 24 64 62 5d 0a 09 ::Unmount $db].. 4c40: 72 65 74 75 72 6e 20 24 64 62 0a 20 20 20 20 7d return $db. } 4c50: 0a 0a 20 20 20 20 70 72 6f 63 20 55 6e 6d 6f 75 .. proc Unmou 4c60: 6e 74 20 7b 64 62 20 6c 6f 63 61 6c 7d 20 7b 0a nt {db local} {. 4c70: 09 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 6d .vfs::filesystem 4c80: 20 75 6e 6d 6f 75 6e 74 20 24 6c 6f 63 61 6c 0a unmount $local. 4c90: 09 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 5f 75 6d .::mkcl_vfs::_um 4ca0: 6f 75 6e 74 20 24 64 62 0a 20 20 20 20 7d 0a 0a ount $db. }.. 4cb0: 20 20 20 20 70 72 6f 63 20 61 74 74 72 69 62 75 proc attribu 4cc0: 74 65 73 20 7b 64 62 7d 20 7b 20 72 65 74 75 72 tes {db} { retur 4cd0: 6e 20 5b 6c 69 73 74 20 22 73 74 61 74 65 22 20 n [list "state" 4ce0: 22 63 6f 6d 6d 69 74 22 5d 20 7d 0a 20 20 20 20 "commit"] }. 4cf0: 0a 20 20 20 20 23 20 43 61 6e 20 75 73 65 20 74 . # Can use t 4d00: 68 69 73 20 74 6f 20 63 6f 6e 74 72 6f 6c 20 63 his to control c 4d10: 6f 6d 6d 69 74 2f 6e 6f 63 6f 6d 6d 69 74 20 6f ommit/nocommit o 4d20: 72 20 77 68 61 74 65 76 65 72 2e 0a 20 20 20 20 r whatever.. 4d30: 23 20 49 27 6d 20 6e 6f 74 20 73 75 72 65 20 79 # I'm not sure y 4d40: 65 74 20 6f 66 20 77 68 61 74 20 66 75 6e 63 74 et of what funct 4d50: 69 6f 6e 61 6c 69 74 79 20 6a 63 77 20 6e 65 65 ionality jcw nee 4d60: 64 73 2e 0a 20 20 20 20 70 72 6f 63 20 63 6f 6d ds.. proc com 4d70: 6d 69 74 20 7b 64 62 20 61 72 67 73 7d 20 7b 0a mit {db args} {. 4d80: 09 73 77 69 74 63 68 20 2d 2d 20 5b 6c 6c 65 6e .switch -- [llen 4d90: 67 74 68 20 24 61 72 67 73 5d 20 7b 0a 09 20 20 gth $args] {.. 4da0: 20 20 30 20 7b 0a 09 09 69 66 20 7b 24 3a 3a 6d 0 {...if {$::m 4db0: 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a 6d 6f 64 65 kcl_vfs::v::mode 4dc0: 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 6f 6e ($db) == "readon 4dd0: 6c 79 22 7d 20 7b 0a 09 09 20 20 20 20 72 65 74 ly"} {... ret 4de0: 75 72 6e 20 30 0a 09 09 7d 20 65 6c 73 65 20 7b urn 0...} else { 4df0: 0a 09 09 20 20 20 20 23 20 54 6f 20 44 6f 3a 20 ... # To Do: 4e00: 72 65 61 64 20 74 68 65 20 63 6f 6d 6d 69 74 20 read the commit 4e10: 73 74 61 74 65 0a 09 09 20 20 20 20 72 65 74 75 state... retu 4e20: 72 6e 20 31 0a 09 09 7d 0a 09 20 20 20 20 7d 0a rn 1...}.. }. 4e30: 09 20 20 20 20 31 20 7b 0a 09 09 73 65 74 20 76 . 1 {...set v 4e40: 61 6c 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 al [lindex $args 4e50: 20 30 5d 0a 09 09 69 66 20 7b 24 76 61 6c 20 21 0]...if {$val ! 4e60: 3d 20 30 20 26 26 20 24 76 61 6c 20 21 3d 20 31 = 0 && $val != 1 4e70: 7d 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e } {... return 4e80: 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 5c 0a 09 -code error \.. 4e90: 09 20 20 20 20 20 20 22 69 6e 76 61 6c 69 64 20 . "invalid 4ea0: 63 6f 6d 6d 69 74 20 76 61 6c 75 65 20 24 76 61 commit value $va 4eb0: 6c 2c 20 6d 75 73 74 20 62 65 20 30 2c 31 22 0a l, must be 0,1". 4ec0: 09 09 7d 0a 09 09 23 20 54 6f 20 44 6f 3a 20 73 ..}...# To Do: s 4ed0: 65 74 20 74 68 65 20 63 6f 6d 6d 69 74 20 73 74 et the commit st 4ee0: 61 74 65 2e 0a 09 20 20 20 20 7d 0a 09 20 20 20 ate... }.. 4ef0: 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 72 65 74 default {...ret 4f00: 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 urn -code error 4f10: 22 57 72 6f 6e 67 20 6e 75 6d 20 61 72 67 73 22 "Wrong num args" 4f20: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. } 4f30: 0a 20 20 20 20 0a 20 20 20 20 70 72 6f 63 20 73 . . proc s 4f40: 74 61 74 65 20 7b 64 62 20 61 72 67 73 7d 20 7b tate {db args} { 4f50: 0a 09 73 77 69 74 63 68 20 2d 2d 20 5b 6c 6c 65 ..switch -- [lle 4f60: 6e 67 74 68 20 24 61 72 67 73 5d 20 7b 0a 09 20 ngth $args] {.. 4f70: 20 20 20 30 20 7b 0a 09 09 72 65 74 75 72 6e 20 0 {...return 4f80: 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a $::mkcl_vfs::v:: 4f90: 6d 6f 64 65 28 24 64 62 29 0a 09 20 20 20 20 7d mode($db).. } 4fa0: 0a 09 20 20 20 20 31 20 7b 0a 09 09 73 65 74 20 .. 1 {...set 4fb0: 76 61 6c 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 val [lindex $arg 4fc0: 73 20 30 5d 0a 09 09 69 66 20 7b 5b 6c 73 65 61 s 0]...if {[lsea 4fd0: 72 63 68 20 2d 65 78 61 63 74 20 5b 3a 3a 76 66 rch -exact [::vf 4fe0: 73 3a 3a 73 74 61 74 65 73 5d 20 24 76 61 6c 5d s::states] $val] 4ff0: 20 3d 3d 20 2d 31 7d 20 7b 0a 09 09 20 20 20 20 == -1} {... 5000: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 return -code err 5010: 6f 72 20 5c 0a 09 09 20 20 20 20 20 20 22 69 6e or \... "in 5020: 76 61 6c 69 64 20 73 74 61 74 65 20 24 76 61 6c valid state $val 5030: 2c 20 6d 75 73 74 20 62 65 20 6f 6e 65 20 6f 66 , must be one of 5040: 3a 20 5b 76 66 73 3a 3a 73 74 61 74 65 73 5d 22 : [vfs::states]" 5050: 0a 09 09 7d 0a 09 09 73 65 74 20 3a 3a 6d 6b 63 ...}...set ::mkc 5060: 6c 5f 76 66 73 3a 3a 76 3a 3a 6d 6f 64 65 28 24 l_vfs::v::mode($ 5070: 64 62 29 20 24 76 61 6c 0a 09 09 3a 3a 6d 6b 63 db) $val...::mkc 5080: 6c 5f 76 66 73 3a 3a 73 65 74 75 70 43 6f 6d 6d l_vfs::setupComm 5090: 69 74 73 20 24 64 62 0a 09 20 20 20 20 7d 0a 09 its $db.. }.. 50a0: 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 default {... 50b0: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 return -code err 50c0: 6f 72 20 22 57 72 6f 6e 67 20 6e 75 6d 20 61 72 or "Wrong num ar 50d0: 67 73 22 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 gs".. }..}. 50e0: 20 20 7d 0a 20 20 20 20 0a 20 20 20 20 70 72 6f }. . pro 50f0: 63 20 68 61 6e 64 6c 65 72 20 7b 64 62 20 63 6d c handler {db cm 5100: 64 20 72 6f 6f 74 20 72 65 6c 61 74 69 76 65 20 d root relative 5110: 61 63 74 75 61 6c 70 61 74 68 20 61 72 67 73 7d actualpath args} 5120: 20 7b 0a 09 23 70 75 74 73 20 73 74 64 65 72 72 {..#puts stderr 5130: 20 22 68 61 6e 64 6c 65 72 3a 20 24 64 62 20 2d "handler: $db - 5140: 20 24 63 6d 64 20 2d 20 24 72 6f 6f 74 20 2d 20 $cmd - $root - 5150: 24 72 65 6c 61 74 69 76 65 20 2d 20 24 61 63 74 $relative - $act 5160: 75 61 6c 70 61 74 68 20 2d 20 24 61 72 67 73 22 ualpath - $args" 5170: 0a 09 69 66 20 7b 24 63 6d 64 20 3d 3d 20 22 6d ..if {$cmd == "m 5180: 61 74 63 68 69 6e 64 69 72 65 63 74 6f 72 79 22 atchindirectory" 5190: 7d 20 7b 0a 09 20 20 20 20 65 76 61 6c 20 5b 6c } {.. eval [l 51a0: 69 73 74 20 24 63 6d 64 20 24 64 62 20 24 72 65 ist $cmd $db $re 51b0: 6c 61 74 69 76 65 20 24 61 63 74 75 61 6c 70 61 lative $actualpa 51c0: 74 68 5d 20 24 61 72 67 73 0a 09 7d 20 65 6c 73 th] $args..} els 51d0: 65 69 66 20 7b 24 63 6d 64 20 3d 3d 20 22 66 69 eif {$cmd == "fi 51e0: 6c 65 61 74 74 72 69 62 75 74 65 73 22 7d 20 7b leattributes"} { 51f0: 0a 09 20 20 20 20 65 76 61 6c 20 5b 6c 69 73 74 .. eval [list 5200: 20 24 63 6d 64 20 24 64 62 20 24 72 6f 6f 74 20 $cmd $db $root 5210: 24 72 65 6c 61 74 69 76 65 5d 20 24 61 72 67 73 $relative] $args 5220: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {.. 5230: 65 76 61 6c 20 5b 6c 69 73 74 20 24 63 6d 64 20 eval [list $cmd 5240: 24 64 62 20 24 72 65 6c 61 74 69 76 65 5d 20 24 $db $relative] $ 5250: 61 72 67 73 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 args..}. }.. 5260: 20 20 20 70 72 6f 63 20 75 74 69 6d 65 20 7b 64 proc utime {d 5270: 62 20 70 61 74 68 20 61 63 74 69 6d 65 20 6d 6f b path actime mo 5280: 64 74 69 6d 65 7d 20 7b 0a 09 3a 3a 6d 6b 63 6c dtime} {..::mkcl 5290: 5f 76 66 73 3a 3a 73 74 61 74 20 24 64 62 20 24 _vfs::stat $db $ 52a0: 70 61 74 68 20 73 62 0a 09 0a 09 69 66 20 7b 20 path sb....if { 52b0: 24 73 62 28 74 79 70 65 29 20 3d 3d 20 22 66 69 $sb(type) == "fi 52c0: 6c 65 22 20 7d 20 7b 0a 09 20 20 20 20 72 65 61 le" } {.. rea 52d0: 64 6b 69 74 3a 3a 73 65 74 20 24 73 62 28 69 6e dkit::set $sb(in 52e0: 6f 29 20 64 61 74 65 20 24 6d 6f 64 74 69 6d 65 o) date $modtime 52f0: 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 ..}. }.. p 5300: 72 6f 63 20 6d 61 74 63 68 69 6e 64 69 72 65 63 roc matchindirec 5310: 74 6f 72 79 20 7b 64 62 20 70 61 74 68 20 61 63 tory {db path ac 5320: 74 75 61 6c 70 61 74 68 20 70 61 74 74 65 72 6e tualpath pattern 5330: 20 74 79 70 65 7d 20 7b 0a 09 73 65 74 20 6e 65 type} {..set ne 5340: 77 72 65 73 20 5b 6c 69 73 74 5d 0a 09 69 66 20 wres [list]..if 5350: 7b 21 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {![string length 5360: 20 24 70 61 74 74 65 72 6e 5d 7d 20 7b 0a 09 20 $pattern]} {.. 5370: 20 20 20 23 20 63 68 65 63 6b 20 73 69 6e 67 6c # check singl 5380: 65 20 66 69 6c 65 0a 09 20 20 20 20 69 66 20 7b e file.. if { 5390: 5b 63 61 74 63 68 20 7b 61 63 63 65 73 73 20 24 [catch {access $ 53a0: 64 62 20 24 70 61 74 68 20 30 7d 5d 7d 20 7b 0a db $path 0}]} {. 53b0: 09 09 72 65 74 75 72 6e 20 7b 7d 0a 09 20 20 20 ..return {}.. 53c0: 20 7d 0a 09 20 20 20 20 73 65 74 20 72 65 73 20 }.. set res 53d0: 5b 6c 69 73 74 20 24 61 63 74 75 61 6c 70 61 74 [list $actualpat 53e0: 68 5d 0a 09 20 20 20 20 73 65 74 20 61 63 74 75 h].. set actu 53f0: 61 6c 70 61 74 68 20 22 22 0a 09 7d 20 65 6c 73 alpath ""..} els 5400: 65 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 73 e {.. set res 5410: 20 5b 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 67 65 [::mkcl_vfs::ge 5420: 74 64 69 72 20 24 64 62 20 24 70 61 74 68 20 24 tdir $db $path $ 5430: 70 61 74 74 65 72 6e 5d 0a 09 7d 0a 09 66 6f 72 pattern]..}..for 5440: 65 61 63 68 20 70 20 5b 3a 3a 76 66 73 3a 3a 6d each p [::vfs::m 5450: 61 74 63 68 43 6f 72 72 65 63 74 54 79 70 65 73 atchCorrectTypes 5460: 20 24 74 79 70 65 20 24 72 65 73 20 24 61 63 74 $type $res $act 5470: 75 61 6c 70 61 74 68 5d 20 7b 0a 09 20 20 20 20 ualpath] {.. 5480: 6c 61 70 70 65 6e 64 20 6e 65 77 72 65 73 20 5b lappend newres [ 5490: 66 69 6c 65 20 6a 6f 69 6e 20 24 61 63 74 75 61 file join $actua 54a0: 6c 70 61 74 68 20 24 70 5d 0a 09 7d 0a 09 72 65 lpath $p]..}..re 54b0: 74 75 72 6e 20 24 6e 65 77 72 65 73 0a 20 20 20 turn $newres. 54c0: 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 73 74 61 }.. proc sta 54d0: 74 20 7b 64 62 20 6e 61 6d 65 7d 20 7b 0a 09 3a t {db name} {..: 54e0: 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 73 74 61 74 20 :mkcl_vfs::stat 54f0: 24 64 62 20 24 6e 61 6d 65 20 73 62 0a 0a 09 73 $db $name sb...s 5500: 65 74 20 73 62 28 69 6e 6f 29 20 30 0a 09 61 72 et sb(ino) 0..ar 5510: 72 61 79 20 67 65 74 20 73 62 0a 20 20 20 20 7d ray get sb. } 5520: 0a 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 73 .. proc acces 5530: 73 20 7b 64 62 20 6e 61 6d 65 20 6d 6f 64 65 7d s {db name mode} 5540: 20 7b 0a 09 69 66 20 7b 24 6d 6f 64 65 20 26 20 {..if {$mode & 5550: 32 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 3a 2} {.. if {$: 5560: 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a 6d 6f :mkcl_vfs::v::mo 5570: 64 65 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 de($db) == "read 5580: 6f 6e 6c 79 22 7d 20 7b 0a 09 09 76 66 73 3a 3a only"} {...vfs:: 5590: 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 filesystem posix 55a0: 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f error $::vfs::po 55b0: 73 69 78 28 45 52 4f 46 53 29 0a 09 20 20 20 20 six(EROFS).. 55c0: 7d 0a 09 7d 0a 09 23 20 57 65 20 63 61 6e 20 70 }..}..# We can p 55d0: 72 6f 62 61 62 6c 79 20 64 6f 20 74 68 69 73 20 robably do this 55e0: 6d 6f 72 65 20 65 66 66 69 63 69 65 6e 74 6c 79 more efficiently 55f0: 2c 20 63 61 6e 27 74 20 77 65 3f 0a 09 3a 3a 6d , can't we?..::m 5600: 6b 63 6c 5f 76 66 73 3a 3a 73 74 61 74 20 24 64 kcl_vfs::stat $d 5610: 62 20 24 6e 61 6d 65 20 73 62 0a 20 20 20 20 7d b $name sb. } 5620: 0a 0a 20 20 20 20 70 72 6f 63 20 6f 70 65 6e 20 .. proc open 5630: 7b 64 62 20 66 69 6c 65 20 6d 6f 64 65 20 70 65 {db file mode pe 5640: 72 6d 69 73 73 69 6f 6e 73 7d 20 7b 0a 09 23 20 rmissions} {..# 5650: 72 65 74 75 72 6e 20 61 20 6c 69 73 74 20 6f 66 return a list of 5660: 20 74 77 6f 20 65 6c 65 6d 65 6e 74 73 3a 0a 09 two elements:.. 5670: 23 20 31 2e 20 66 69 72 73 74 20 65 6c 65 6d 65 # 1. first eleme 5680: 6e 74 20 69 73 20 74 68 65 20 54 63 6c 20 63 68 nt is the Tcl ch 5690: 61 6e 6e 65 6c 20 6e 61 6d 65 20 77 68 69 63 68 annel name which 56a0: 20 68 61 73 20 62 65 65 6e 20 6f 70 65 6e 65 64 has been opened 56b0: 0a 09 23 20 32 2e 20 73 65 63 6f 6e 64 20 65 6c ..# 2. second el 56c0: 65 6d 65 6e 74 20 28 6f 70 74 69 6f 6e 61 6c 29 ement (optional) 56d0: 20 69 73 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f is a command to 56e0: 20 65 76 61 6c 75 61 74 65 20 77 68 65 6e 0a 09 evaluate when.. 56f0: 23 20 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 69 # the channel i 5700: 73 20 63 6c 6f 73 65 64 2e 0a 09 73 77 69 74 63 s closed...switc 5710: 68 20 2d 67 6c 6f 62 20 2d 2d 20 24 6d 6f 64 65 h -glob -- $mode 5720: 20 7b 0a 09 20 20 20 20 7b 7d 20 20 2d 0a 09 20 {.. {} -.. 5730: 20 20 20 72 20 7b 0a 09 09 3a 3a 6d 6b 63 6c 5f r {...::mkcl_ 5740: 76 66 73 3a 3a 73 74 61 74 20 24 64 62 20 24 66 vfs::stat $db $f 5750: 69 6c 65 20 73 62 0a 0a 09 09 69 66 20 7b 20 24 ile sb....if { $ 5760: 73 62 28 63 73 69 7a 65 29 20 21 3d 20 24 73 62 sb(csize) != $sb 5770: 28 73 69 7a 65 29 20 7d 20 7b 0a 09 09 20 20 20 (size) } {... 5780: 20 69 66 20 7b 24 3a 3a 6d 6b 63 6c 5f 76 66 73 if {$::mkcl_vfs 5790: 3a 3a 7a 73 74 72 65 61 6d 65 64 7d 20 7b 0a 09 ::zstreamed} {.. 57a0: 09 20 20 20 20 20 20 73 65 74 20 66 64 20 5b 72 . set fd [r 57b0: 65 61 64 6b 69 74 3a 3a 63 68 61 6e 6e 65 6c 20 eadkit::channel 57c0: 24 73 62 28 69 6e 6f 29 20 63 6f 6e 74 65 6e 74 $sb(ino) content 57d0: 73 20 72 5d 0a 09 09 20 20 20 20 20 20 66 63 6f s r]... fco 57e0: 6e 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 nfigure $fd -tra 57f0: 6e 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a nslation binary. 5800: 09 09 20 20 20 20 20 20 73 65 74 20 66 64 20 5b .. set fd [ 5810: 76 66 73 3a 3a 7a 73 74 72 65 61 6d 20 64 65 63 vfs::zstream dec 5820: 6f 6d 70 72 65 73 73 20 24 66 64 20 24 73 62 28 ompress $fd $sb( 5830: 63 73 69 7a 65 29 20 24 73 62 28 73 69 7a 65 29 csize) $sb(size) 5840: 5d 0a 09 09 20 20 20 20 7d 20 65 6c 73 65 20 7b ]... } else { 5850: 0a 09 09 20 20 20 20 20 20 73 65 74 20 66 64 20 ... set fd 5860: 5b 76 66 73 3a 3a 6d 65 6d 63 68 61 6e 5d 0a 09 [vfs::memchan].. 5870: 09 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 . fconfigur 5880: 65 20 24 66 64 20 2d 74 72 61 6e 73 6c 61 74 69 e $fd -translati 5890: 6f 6e 20 62 69 6e 61 72 79 0a 09 09 20 20 20 20 on binary... 58a0: 20 20 73 65 74 20 73 20 5b 72 65 61 64 6b 69 74 set s [readkit 58b0: 3a 3a 67 65 74 20 24 73 62 28 69 6e 6f 29 20 63 ::get $sb(ino) c 58c0: 6f 6e 74 65 6e 74 73 5d 0a 09 09 20 20 20 20 20 ontents]... 58d0: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline 58e0: 20 24 66 64 20 5b 76 66 73 3a 3a 7a 69 70 20 2d $fd [vfs::zip - 58f0: 6d 6f 64 65 20 64 65 63 6f 6d 70 72 65 73 73 20 mode decompress 5900: 24 73 5d 0a 0a 09 09 20 20 20 20 20 20 66 63 6f $s].... fco 5910: 6e 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 nfigure $fd -tra 5920: 6e 73 6c 61 74 69 6f 6e 20 61 75 74 6f 0a 09 09 nslation auto... 5930: 20 20 20 20 20 20 73 65 65 6b 20 24 66 64 20 30 seek $fd 0 5940: 0a 09 09 20 20 20 20 7d 0a 09 09 7d 20 65 6c 73 ... }...} els 5950: 65 69 66 20 7b 20 24 3a 3a 6d 6b 63 6c 5f 76 66 eif { $::mkcl_vf 5960: 73 3a 3a 64 69 72 65 63 74 20 7d 20 7b 0a 09 09 s::direct } {... 5970: 20 20 20 20 73 65 74 20 66 64 20 5b 76 66 73 3a set fd [vfs: 5980: 3a 6d 65 6d 63 68 61 6e 5d 0a 09 09 20 20 20 20 :memchan]... 5990: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 64 20 2d fconfigure $fd - 59a0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 62 69 6e 61 translation bina 59b0: 72 79 0a 09 09 20 20 20 20 70 75 74 73 20 2d 6e ry... puts -n 59c0: 6f 6e 65 77 6c 69 6e 65 20 24 66 64 20 5b 72 65 onewline $fd [re 59d0: 61 64 6b 69 74 3a 3a 67 65 74 20 24 73 62 28 69 adkit::get $sb(i 59e0: 6e 6f 29 20 63 6f 6e 74 65 6e 74 73 5d 0a 0a 09 no) contents]... 59f0: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure 5a00: 24 66 64 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e $fd -translation 5a10: 20 61 75 74 6f 0a 09 09 20 20 20 20 73 65 65 6b auto... seek 5a20: 20 24 66 64 20 30 0a 09 09 7d 20 65 6c 73 65 20 $fd 0...} else 5a30: 7b 0a 09 09 20 20 20 20 73 65 74 20 66 64 20 5b {... set fd [ 5a40: 72 65 61 64 6b 69 74 3a 3a 63 68 61 6e 6e 65 6c readkit::channel 5a50: 20 24 73 62 28 69 6e 6f 29 20 63 6f 6e 74 65 6e $sb(ino) conten 5a60: 74 73 20 72 5d 0a 09 09 7d 0a 09 09 72 65 74 75 ts r]...}...retu 5a70: 72 6e 20 5b 6c 69 73 74 20 24 66 64 5d 0a 09 20 rn [list $fd].. 5a80: 20 20 20 7d 0a 09 20 20 20 20 61 20 7b 0a 09 09 }.. a {... 5a90: 69 66 20 7b 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a if {$::mkcl_vfs: 5aa0: 3a 76 3a 3a 6d 6f 64 65 28 24 64 62 29 20 3d 3d :v::mode($db) == 5ab0: 20 22 72 65 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 "readonly"} {.. 5ac0: 09 20 20 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 . vfs::filesy 5ad0: 73 74 65 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 stem posixerror 5ae0: 24 3a 3a 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 $::vfs::posix(ER 5af0: 4f 46 53 29 0a 09 09 7d 0a 09 09 69 66 20 7b 20 OFS)...}...if { 5b00: 5b 63 61 74 63 68 20 7b 3a 3a 6d 6b 63 6c 5f 76 [catch {::mkcl_v 5b10: 66 73 3a 3a 73 74 61 74 20 24 64 62 20 24 66 69 fs::stat $db $fi 5b20: 6c 65 20 73 62 20 7d 5d 20 7d 20 7b 0a 09 09 20 le sb }] } {... 5b30: 20 20 20 23 20 43 72 65 61 74 65 20 66 69 6c 65 # Create file 5b40: 0a 09 09 20 20 20 20 3a 3a 6d 6b 63 6c 5f 76 66 ... ::mkcl_vf 5b50: 73 3a 3a 73 74 61 74 20 24 64 62 20 5b 66 69 6c s::stat $db [fil 5b60: 65 20 64 69 72 6e 61 6d 65 20 24 66 69 6c 65 5d e dirname $file] 5b70: 20 73 62 0a 09 09 20 20 20 20 73 65 74 20 74 61 sb... set ta 5b80: 69 6c 20 5b 66 69 6c 65 20 74 61 69 6c 20 24 66 il [file tail $f 5b90: 69 6c 65 5d 0a 09 09 20 20 20 20 73 65 74 20 66 ile]... set f 5ba0: 76 69 65 77 20 24 73 62 28 69 6e 6f 29 2e 66 69 view $sb(ino).fi 5bb0: 6c 65 73 0a 09 09 20 20 20 20 69 66 20 7b 5b 69 les... if {[i 5bc0: 6e 66 6f 20 65 78 69 73 74 73 20 6d 6b 63 6c 5f nfo exists mkcl_ 5bd0: 76 66 73 3a 3a 76 3a 3a 66 63 61 63 68 65 28 24 vfs::v::fcache($ 5be0: 66 76 69 65 77 29 5d 7d 20 7b 0a 09 09 09 6c 61 fview)]} {....la 5bf0: 70 70 65 6e 64 20 6d 6b 63 6c 5f 76 66 73 3a 3a ppend mkcl_vfs:: 5c00: 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 65 77 v::fcache($fview 5c10: 29 20 24 74 61 69 6c 0a 09 09 20 20 20 20 7d 0a ) $tail... }. 5c20: 09 09 20 20 20 20 73 65 74 20 6e 6f 77 20 5b 63 .. set now [c 5c30: 6c 6f 63 6b 20 73 65 63 6f 6e 64 73 5d 0a 09 09 lock seconds]... 5c40: 20 20 20 20 73 65 74 20 73 62 28 69 6e 6f 29 20 set sb(ino) 5c50: 5b 72 65 61 64 6b 69 74 3a 3a 72 6f 77 20 61 70 [readkit::row ap 5c60: 70 65 6e 64 20 24 66 76 69 65 77 20 5c 0a 09 09 pend $fview \... 5c70: 09 20 20 20 20 6e 61 6d 65 20 24 74 61 69 6c 20 . name $tail 5c80: 73 69 7a 65 20 30 20 64 61 74 65 20 24 6e 6f 77 size 0 date $now 5c90: 20 5d 0a 0a 09 09 20 20 20 20 69 66 20 7b 20 5b ].... if { [ 5ca0: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 2a 7a 2a string match *z* 5cb0: 20 24 6d 6f 64 65 5d 20 7c 7c 20 24 6d 6b 63 6c $mode] || $mkcl 5cc0: 5f 76 66 73 3a 3a 63 6f 6d 70 72 65 73 73 20 7d _vfs::compress } 5cd0: 20 7b 0a 09 09 09 73 65 74 20 73 62 28 63 73 69 {....set sb(csi 5ce0: 7a 65 29 20 2d 31 20 20 3b 23 20 48 41 43 4b 20 ze) -1 ;# HACK 5cf0: 2d 20 66 6f 72 63 65 20 63 6f 6d 70 72 65 73 73 - force compress 5d00: 69 6f 6e 0a 09 09 20 20 20 20 7d 20 65 6c 73 65 ion... } else 5d10: 20 7b 0a 09 09 09 73 65 74 20 73 62 28 63 73 69 {....set sb(csi 5d20: 7a 65 29 20 30 0a 09 09 20 20 20 20 7d 0a 09 09 ze) 0... }... 5d30: 7d 0a 0a 09 09 73 65 74 20 66 64 20 5b 76 66 73 }....set fd [vfs 5d40: 3a 3a 6d 65 6d 63 68 61 6e 5d 0a 09 09 66 63 6f ::memchan]...fco 5d50: 6e 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 nfigure $fd -tra 5d60: 6e 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a nslation binary. 5d70: 09 09 73 65 74 20 73 20 5b 72 65 61 64 6b 69 74 ..set s [readkit 5d80: 3a 3a 67 65 74 20 24 73 62 28 69 6e 6f 29 20 63 ::get $sb(ino) c 5d90: 6f 6e 74 65 6e 74 73 5d 0a 0a 09 09 69 66 20 7b ontents]....if { 5da0: 20 24 73 62 28 63 73 69 7a 65 29 20 21 3d 20 24 $sb(csize) != $ 5db0: 73 62 28 73 69 7a 65 29 20 26 26 20 24 73 62 28 sb(size) && $sb( 5dc0: 63 73 69 7a 65 29 20 3e 20 30 20 7d 20 7b 0a 09 csize) > 0 } {.. 5dd0: 09 20 20 20 20 61 70 70 65 6e 64 20 6d 6f 64 65 . append mode 5de0: 20 7a 0a 09 09 20 20 20 20 70 75 74 73 20 2d 6e z... puts -n 5df0: 6f 6e 65 77 6c 69 6e 65 20 24 66 64 20 5b 76 66 onewline $fd [vf 5e00: 73 3a 3a 7a 69 70 20 2d 6d 6f 64 65 20 64 65 63 s::zip -mode dec 5e10: 6f 6d 70 72 65 73 73 20 24 73 5d 0a 09 09 7d 20 ompress $s]...} 5e20: 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 69 66 20 else {... if 5e30: 7b 20 24 6d 6b 63 6c 5f 76 66 73 3a 3a 63 6f 6d { $mkcl_vfs::com 5e40: 70 72 65 73 73 20 7d 20 7b 20 61 70 70 65 6e 64 press } { append 5e50: 20 6d 6f 64 65 20 7a 20 7d 0a 09 09 20 20 20 20 mode z }... 5e60: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline 5e70: 24 66 64 20 24 73 0a 09 09 20 20 20 20 23 73 65 $fd $s... #se 5e80: 74 20 66 64 20 5b 72 65 61 64 6b 69 74 3a 3a 63 t fd [readkit::c 5e90: 68 61 6e 6e 65 6c 20 24 73 62 28 69 6e 6f 29 20 hannel $sb(ino) 5ea0: 63 6f 6e 74 65 6e 74 73 20 61 5d 0a 09 09 7d 0a contents a]...}. 5eb0: 09 09 66 63 6f 6e 66 69 67 75 72 65 20 24 66 64 ..fconfigure $fd 5ec0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 61 75 -translation au 5ed0: 74 6f 0a 09 09 73 65 65 6b 20 24 66 64 20 30 20 to...seek $fd 0 5ee0: 65 6e 64 0a 09 09 72 65 74 75 72 6e 20 5b 6c 69 end...return [li 5ef0: 73 74 20 24 66 64 20 5b 6c 69 73 74 20 6d 6b 63 st $fd [list mkc 5f00: 6c 5f 76 66 73 3a 3a 64 6f 5f 63 6c 6f 73 65 20 l_vfs::do_close 5f10: 24 64 62 20 24 66 64 20 24 6d 6f 64 65 20 24 73 $db $fd $mode $s 5f20: 62 28 69 6e 6f 29 5d 5d 0a 09 20 20 20 20 7d 0a b(ino)]].. }. 5f30: 09 20 20 20 20 77 2a 20 20 7b 0a 09 09 69 66 20 . w* {...if 5f40: 7b 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a {$::mkcl_vfs::v: 5f50: 3a 6d 6f 64 65 28 24 64 62 29 20 3d 3d 20 22 72 :mode($db) == "r 5f60: 65 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 09 20 20 eadonly"} {... 5f70: 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 vfs::filesyste 5f80: 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a m posixerror $:: 5f90: 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53 vfs::posix(EROFS 5fa0: 29 0a 09 09 7d 0a 09 09 69 66 20 7b 20 5b 63 61 )...}...if { [ca 5fb0: 74 63 68 20 7b 3a 3a 6d 6b 63 6c 5f 76 66 73 3a tch {::mkcl_vfs: 5fc0: 3a 73 74 61 74 20 24 64 62 20 24 66 69 6c 65 20 :stat $db $file 5fd0: 73 62 20 7d 5d 20 7d 20 7b 0a 09 09 20 20 20 20 sb }] } {... 5fe0: 23 20 43 72 65 61 74 65 20 66 69 6c 65 0a 09 09 # Create file... 5ff0: 20 20 20 20 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a ::mkcl_vfs:: 6000: 73 74 61 74 20 24 64 62 20 5b 66 69 6c 65 20 64 stat $db [file d 6010: 69 72 6e 61 6d 65 20 24 66 69 6c 65 5d 20 73 62 irname $file] sb 6020: 0a 09 09 20 20 20 20 73 65 74 20 74 61 69 6c 20 ... set tail 6030: 5b 66 69 6c 65 20 74 61 69 6c 20 24 66 69 6c 65 [file tail $file 6040: 5d 0a 09 09 20 20 20 20 73 65 74 20 66 76 69 65 ]... set fvie 6050: 77 20 24 73 62 28 69 6e 6f 29 2e 66 69 6c 65 73 w $sb(ino).files 6060: 0a 09 09 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f ... if {[info 6070: 20 65 78 69 73 74 73 20 6d 6b 63 6c 5f 76 66 73 exists mkcl_vfs 6080: 3a 3a 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 ::v::fcache($fvi 6090: 65 77 29 5d 7d 20 7b 0a 09 09 09 6c 61 70 70 65 ew)]} {....lappe 60a0: 6e 64 20 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a nd mkcl_vfs::v:: 60b0: 66 63 61 63 68 65 28 24 66 76 69 65 77 29 20 24 fcache($fview) $ 60c0: 74 61 69 6c 0a 09 09 20 20 20 20 7d 0a 09 09 20 tail... }... 60d0: 20 20 20 73 65 74 20 6e 6f 77 20 5b 63 6c 6f 63 set now [cloc 60e0: 6b 20 73 65 63 6f 6e 64 73 5d 0a 09 09 20 20 20 k seconds]... 60f0: 20 73 65 74 20 73 62 28 69 6e 6f 29 20 5b 72 65 set sb(ino) [re 6100: 61 64 6b 69 74 3a 3a 72 6f 77 20 61 70 70 65 6e adkit::row appen 6110: 64 20 24 66 76 69 65 77 20 5c 0a 09 09 09 20 20 d $fview \.... 6120: 20 20 6e 61 6d 65 20 24 74 61 69 6c 20 73 69 7a name $tail siz 6130: 65 20 30 20 64 61 74 65 20 24 6e 6f 77 20 5d 0a e 0 date $now ]. 6140: 09 09 7d 0a 0a 09 09 69 66 20 7b 20 5b 73 74 72 ..}....if { [str 6150: 69 6e 67 20 6d 61 74 63 68 20 2a 7a 2a 20 24 6d ing match *z* $m 6160: 6f 64 65 5d 20 7c 7c 20 24 6d 6b 63 6c 5f 76 66 ode] || $mkcl_vf 6170: 73 3a 3a 63 6f 6d 70 72 65 73 73 20 7d 20 7b 0a s::compress } {. 6180: 09 09 20 20 20 20 61 70 70 65 6e 64 20 6d 6f 64 .. append mod 6190: 65 20 7a 0a 09 09 20 20 20 20 73 65 74 20 66 64 e z... set fd 61a0: 20 5b 76 66 73 3a 3a 6d 65 6d 63 68 61 6e 5d 0a [vfs::memchan]. 61b0: 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 ..} else {... 61c0: 20 73 65 74 20 66 64 20 5b 72 65 61 64 6b 69 74 set fd [readkit 61d0: 3a 3a 63 68 61 6e 6e 65 6c 20 24 73 62 28 69 6e ::channel $sb(in 61e0: 6f 29 20 63 6f 6e 74 65 6e 74 73 20 77 5d 0a 09 o) contents w].. 61f0: 09 7d 0a 09 09 72 65 74 75 72 6e 20 5b 6c 69 73 .}...return [lis 6200: 74 20 24 66 64 20 5b 6c 69 73 74 20 6d 6b 63 6c t $fd [list mkcl 6210: 5f 76 66 73 3a 3a 64 6f 5f 63 6c 6f 73 65 20 24 _vfs::do_close $ 6220: 64 62 20 24 66 64 20 24 6d 6f 64 65 20 24 73 62 db $fd $mode $sb 6230: 28 69 6e 6f 29 5d 5d 0a 09 20 20 20 20 7d 0a 09 (ino)]].. }.. 6240: 20 20 20 20 64 65 66 61 75 6c 74 20 20 20 7b 0a default {. 6250: 09 09 65 72 72 6f 72 20 22 69 6c 6c 65 67 61 6c ..error "illegal 6260: 20 61 63 63 65 73 73 20 6d 6f 64 65 20 5c 22 24 access mode \"$ 6270: 6d 6f 64 65 5c 22 22 0a 09 20 20 20 20 7d 0a 09 mode\"".. }.. 6280: 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f }. }.. pro 6290: 63 20 63 72 65 61 74 65 64 69 72 65 63 74 6f 72 c createdirector 62a0: 79 20 7b 64 62 20 6e 61 6d 65 7d 20 7b 0a 09 6d y {db name} {..m 62b0: 6b 63 6c 5f 76 66 73 3a 3a 6d 6b 64 69 72 20 24 kcl_vfs::mkdir $ 62c0: 64 62 20 24 6e 61 6d 65 0a 20 20 20 20 7d 0a 0a db $name. }.. 62d0: 20 20 20 20 70 72 6f 63 20 72 65 6d 6f 76 65 64 proc removed 62e0: 69 72 65 63 74 6f 72 79 20 7b 64 62 20 6e 61 6d irectory {db nam 62f0: 65 20 72 65 63 75 72 73 69 76 65 7d 20 7b 0a 09 e recursive} {.. 6300: 6d 6b 63 6c 5f 76 66 73 3a 3a 64 65 6c 65 74 65 mkcl_vfs::delete 6310: 20 24 64 62 20 24 6e 61 6d 65 20 24 72 65 63 75 $db $name $recu 6320: 72 73 69 76 65 0a 20 20 20 20 7d 0a 0a 20 20 20 rsive. }.. 6330: 20 70 72 6f 63 20 64 65 6c 65 74 65 66 69 6c 65 proc deletefile 6340: 20 7b 64 62 20 6e 61 6d 65 7d 20 7b 0a 09 6d 6b {db name} {..mk 6350: 63 6c 5f 76 66 73 3a 3a 64 65 6c 65 74 65 20 24 cl_vfs::delete $ 6360: 64 62 20 24 6e 61 6d 65 0a 20 20 20 20 7d 0a 0a db $name. }.. 6370: 20 20 20 20 70 72 6f 63 20 66 69 6c 65 61 74 74 proc fileatt 6380: 72 69 62 75 74 65 73 20 7b 64 62 20 72 6f 6f 74 ributes {db root 6390: 20 72 65 6c 61 74 69 76 65 20 61 72 67 73 7d 20 relative args} 63a0: 7b 0a 09 73 77 69 74 63 68 20 2d 2d 20 5b 6c 6c {..switch -- [ll 63b0: 65 6e 67 74 68 20 24 61 72 67 73 5d 20 7b 0a 09 ength $args] {.. 63c0: 20 20 20 20 30 20 7b 0a 09 09 23 20 6c 69 73 74 0 {...# list 63d0: 20 73 74 72 69 6e 67 73 0a 09 09 72 65 74 75 72 strings...retur 63e0: 6e 20 5b 3a 3a 76 66 73 3a 3a 6c 69 73 74 41 74 n [::vfs::listAt 63f0: 74 72 69 62 75 74 65 73 5d 0a 09 20 20 20 20 7d tributes].. } 6400: 0a 09 20 20 20 20 31 20 7b 0a 09 09 23 20 67 65 .. 1 {...# ge 6410: 74 20 76 61 6c 75 65 0a 09 09 73 65 74 20 69 6e t value...set in 6420: 64 65 78 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 dex [lindex $arg 6430: 73 20 30 5d 0a 09 09 72 65 74 75 72 6e 20 5b 3a s 0]...return [: 6440: 3a 76 66 73 3a 3a 61 74 74 72 69 62 75 74 65 73 :vfs::attributes 6450: 47 65 74 20 24 72 6f 6f 74 20 24 72 65 6c 61 74 Get $root $relat 6460: 69 76 65 20 24 69 6e 64 65 78 5d 0a 0a 09 20 20 ive $index]... 6470: 20 20 7d 0a 09 20 20 20 20 32 20 7b 0a 09 09 23 }.. 2 {...# 6480: 20 73 65 74 20 76 61 6c 75 65 0a 09 09 69 66 20 set value...if 6490: 7b 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a {$::mkcl_vfs::v: 64a0: 3a 6d 6f 64 65 28 24 64 62 29 20 3d 3d 20 22 72 :mode($db) == "r 64b0: 65 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 09 20 20 eadonly"} {... 64c0: 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 vfs::filesyste 64d0: 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a m posixerror $:: 64e0: 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53 vfs::posix(EROFS 64f0: 29 0a 09 09 7d 0a 09 09 73 65 74 20 69 6e 64 65 )...}...set inde 6500: 78 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20 x [lindex $args 6510: 30 5d 0a 09 09 73 65 74 20 76 61 6c 20 5b 6c 69 0]...set val [li 6520: 6e 64 65 78 20 24 61 72 67 73 20 31 5d 0a 09 09 ndex $args 1]... 6530: 72 65 74 75 72 6e 20 5b 3a 3a 76 66 73 3a 3a 61 return [::vfs::a 6540: 74 74 72 69 62 75 74 65 73 53 65 74 20 24 72 6f ttributesSet $ro 6550: 6f 74 20 24 72 65 6c 61 74 69 76 65 20 24 69 6e ot $relative $in 6560: 64 65 78 20 24 76 61 6c 5d 0a 09 20 20 20 20 7d dex $val].. } 6570: 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 6e 61 6d ..}. }.}..nam 6580: 65 73 70 61 63 65 20 65 76 61 6c 20 6d 6b 63 6c espace eval mkcl 6590: 5f 76 66 73 20 7b 0a 20 20 20 20 76 61 72 69 61 _vfs {. varia 65a0: 62 6c 65 20 63 6f 6d 70 72 65 73 73 20 31 20 20 ble compress 1 65b0: 20 20 20 3b 23 20 48 41 43 4b 20 2d 20 6e 65 65 ;# HACK - nee 65c0: 64 73 20 74 6f 20 62 65 20 70 61 72 74 20 6f 66 ds to be part of 65d0: 20 22 53 75 70 65 72 2d 42 6c 6f 63 6b 22 0a 20 "Super-Block". 65e0: 20 20 20 76 61 72 69 61 62 6c 65 20 66 6c 75 73 variable flus 65f0: 68 20 20 20 20 35 30 30 30 20 20 3b 23 20 41 75 h 5000 ;# Au 6600: 74 6f 2d 43 6f 6d 6d 69 74 20 66 72 65 71 75 65 to-Commit freque 6610: 6e 63 79 0a 20 20 20 20 76 61 72 69 61 62 6c 65 ncy. variable 6620: 20 64 69 72 65 63 74 20 20 20 30 09 20 20 20 20 direct 0. 6630: 3b 23 20 72 65 61 64 20 74 68 72 6f 75 67 68 20 ;# read through 6640: 61 20 6d 65 6d 63 68 61 6e 2c 20 6f 72 20 66 72 a memchan, or fr 6650: 6f 6d 20 4d 6b 34 74 63 6c 20 69 66 20 7a 65 72 om Mk4tcl if zer 6660: 6f 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 7a o. variable z 6670: 73 74 72 65 61 6d 65 64 20 30 20 20 20 20 3b 23 streamed 0 ;# 6680: 20 64 65 63 6f 6d 70 72 65 73 73 20 6f 6e 20 74 decompress on t 6690: 68 65 20 66 6c 79 20 28 6e 65 65 64 73 20 7a 6c he fly (needs zl 66a0: 69 62 20 31 2e 31 29 0a 0a 20 20 20 20 6e 61 6d ib 1.1).. nam 66b0: 65 73 70 61 63 65 20 65 76 61 6c 20 76 20 7b 0a espace eval v {. 66c0: 09 76 61 72 69 61 62 6c 65 20 73 65 71 20 20 20 .variable seq 66d0: 20 20 20 30 0a 09 76 61 72 69 61 62 6c 65 20 6d 0..variable m 66e0: 6f 64 65 09 20 20 20 20 3b 23 20 61 72 72 61 79 ode. ;# array 66f0: 20 6b 65 79 20 69 73 20 64 62 2c 20 76 61 6c 75 key is db, valu 6700: 65 20 69 73 20 6d 6f 64 65 20 0a 09 20 20 20 20 e is mode .. 6710: 20 20 20 20 20 20 20 20 20 09 20 20 20 20 20 23 . # 6720: 20 28 72 65 61 64 77 72 69 74 65 2f 74 72 61 6e (readwrite/tran 6730: 73 6c 75 63 65 6e 74 2f 72 65 61 64 6f 6e 6c 79 slucent/readonly 6740: 29 0a 09 76 61 72 69 61 62 6c 65 20 74 69 6d 65 )..variable time 6750: 72 09 20 20 20 20 3b 23 20 61 72 72 61 79 20 6b r. ;# array k 6760: 65 79 20 69 73 20 64 62 2c 20 73 65 74 20 74 6f ey is db, set to 6770: 20 61 66 74 65 72 69 64 2c 20 70 65 72 69 6f 64 afterid, period 6780: 69 63 43 6f 6d 6d 69 74 0a 0a 09 61 72 72 61 79 icCommit...array 6790: 20 73 65 74 20 63 61 63 68 65 20 7b 7d 0a 09 61 set cache {}..a 67a0: 72 72 61 79 20 73 65 74 20 66 63 61 63 68 65 20 rray set fcache 67b0: 7b 7d 0a 0a 09 61 72 72 61 79 20 73 65 74 20 6d {}...array set m 67c0: 6f 64 65 20 7b 65 78 65 20 74 72 61 6e 73 6c 75 ode {exe translu 67d0: 63 65 6e 74 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 cent}. }.. 67e0: 20 70 72 6f 63 20 69 6e 69 74 20 7b 64 62 7d 20 proc init {db} 67f0: 7b 0a 09 72 65 61 64 6b 69 74 3a 3a 76 69 65 77 {..readkit::view 6800: 20 6c 61 79 6f 75 74 20 24 64 62 2e 64 69 72 73 layout $db.dirs 6810: 20 5c 0a 09 09 7b 6e 61 6d 65 3a 53 20 70 61 72 \...{name:S par 6820: 65 6e 74 3a 49 20 7b 66 69 6c 65 73 20 7b 6e 61 ent:I {files {na 6830: 6d 65 3a 53 20 73 69 7a 65 3a 49 20 64 61 74 65 me:S size:I date 6840: 3a 49 20 63 6f 6e 74 65 6e 74 73 3a 4d 7d 7d 7d :I contents:M}}} 6850: 0a 0a 09 69 66 20 7b 20 5b 72 65 61 64 6b 69 74 ...if { [readkit 6860: 3a 3a 76 69 65 77 20 73 69 7a 65 20 24 64 62 2e ::view size $db. 6870: 64 69 72 73 5d 20 3d 3d 20 30 20 7d 20 7b 0a 09 dirs] == 0 } {.. 6880: 20 20 20 20 72 65 61 64 6b 69 74 3a 3a 72 6f 77 readkit::row 6890: 20 61 70 70 65 6e 64 20 24 64 62 2e 64 69 72 73 append $db.dirs 68a0: 20 6e 61 6d 65 20 3c 72 6f 6f 74 3e 20 70 61 72 name <root> par 68b0: 65 6e 74 20 2d 31 0a 09 7d 0a 20 20 20 20 7d 0a ent -1..}. }. 68c0: 0a 20 20 20 20 70 72 6f 63 20 5f 6d 6f 75 6e 74 . proc _mount 68d0: 20 7b 7b 66 69 6c 65 20 22 22 7d 20 61 72 67 73 {{file ""} args 68e0: 7d 20 7b 0a 09 73 65 74 20 64 62 20 6d 6b 34 76 } {..set db mk4v 68f0: 66 73 5b 69 6e 63 72 20 76 3a 3a 73 65 71 5d 0a fs[incr v::seq]. 6900: 0a 09 69 66 20 7b 24 66 69 6c 65 20 3d 3d 20 22 ..if {$file == " 6910: 22 7d 20 7b 0a 09 20 20 20 20 72 65 61 64 6b 69 "} {.. readki 6920: 74 3a 3a 66 69 6c 65 20 6f 70 65 6e 20 24 64 62 t::file open $db 6930: 0a 09 20 20 20 20 69 6e 69 74 20 24 64 62 0a 09 .. init $db.. 6940: 20 20 20 20 73 65 74 20 76 3a 3a 6d 6f 64 65 28 set v::mode( 6950: 24 64 62 29 20 22 74 72 61 6e 73 6c 75 63 65 6e $db) "translucen 6960: 74 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 t"..} else {.. 6970: 20 20 65 76 61 6c 20 5b 6c 69 73 74 20 72 65 61 eval [list rea 6980: 64 6b 69 74 3a 3a 66 69 6c 65 20 6f 70 65 6e 20 dkit::file open 6990: 24 64 62 20 24 66 69 6c 65 5d 20 24 61 72 67 73 $db $file] $args 69a0: 0a 09 20 20 20 20 0a 09 20 20 20 20 69 6e 69 74 .. .. init 69b0: 20 24 64 62 0a 09 20 20 20 20 0a 09 20 20 20 20 $db.. .. 69c0: 73 65 74 20 6d 6f 64 65 20 30 0a 09 20 20 20 20 set mode 0.. 69d0: 66 6f 72 65 61 63 68 20 61 72 67 20 24 61 72 67 foreach arg $arg 69e0: 73 20 7b 0a 09 09 73 77 69 74 63 68 20 2d 2d 20 s {...switch -- 69f0: 24 61 72 67 20 7b 0a 09 09 20 20 20 20 2d 72 65 $arg {... -re 6a00: 61 64 6f 6e 6c 79 20 20 20 7b 20 73 65 74 20 6d adonly { set m 6a10: 6f 64 65 20 31 20 7d 0a 09 09 20 20 20 20 2d 6e ode 1 }... -n 6a20: 6f 63 6f 6d 6d 69 74 20 20 20 7b 20 73 65 74 20 ocommit { set 6a30: 6d 6f 64 65 20 32 20 7d 0a 09 09 7d 0a 09 20 20 mode 2 }...}.. 6a40: 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 24 6d 6f }.. if {$mo 6a50: 64 65 20 3d 3d 20 30 7d 20 7b 0a 09 09 70 65 72 de == 0} {...per 6a60: 69 6f 64 69 63 43 6f 6d 6d 69 74 20 24 64 62 0a iodicCommit $db. 6a70: 09 20 20 20 20 7d 0a 09 20 20 20 20 73 65 74 20 . }.. set 6a80: 76 3a 3a 6d 6f 64 65 28 24 64 62 29 20 5b 6c 69 v::mode($db) [li 6a90: 6e 64 65 78 20 7b 74 72 61 6e 73 6c 75 63 65 6e ndex {translucen 6aa0: 74 20 72 65 61 64 77 72 69 74 65 20 72 65 61 64 t readwrite read 6ab0: 77 72 69 74 65 7d 20 24 6d 6f 64 65 5d 0a 09 7d write} $mode]..} 6ac0: 0a 09 72 65 74 75 72 6e 20 24 64 62 0a 20 20 20 ..return $db. 6ad0: 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 70 65 72 }.. proc per 6ae0: 69 6f 64 69 63 43 6f 6d 6d 69 74 20 7b 64 62 7d iodicCommit {db} 6af0: 20 7b 0a 09 76 61 72 69 61 62 6c 65 20 66 6c 75 {..variable flu 6b00: 73 68 0a 09 73 65 74 20 76 3a 3a 74 69 6d 65 72 sh..set v::timer 6b10: 28 24 64 62 29 20 5b 61 66 74 65 72 20 24 66 6c ($db) [after $fl 6b20: 75 73 68 20 5b 6c 69 73 74 20 3a 3a 6d 6b 63 6c ush [list ::mkcl 6b30: 5f 76 66 73 3a 3a 70 65 72 69 6f 64 69 63 43 6f _vfs::periodicCo 6b40: 6d 6d 69 74 20 24 64 62 5d 5d 0a 09 72 65 61 64 mmit $db]]..read 6b50: 6b 69 74 3a 3a 66 69 6c 65 20 63 6f 6d 6d 69 74 kit::file commit 6b60: 20 24 64 62 0a 09 72 65 74 75 72 6e 20 3b 23 20 $db..return ;# 6b70: 32 30 30 35 2d 30 31 2d 32 30 20 61 76 6f 69 64 2005-01-20 avoid 6b80: 20 72 65 74 75 72 6e 69 6e 67 20 61 20 76 61 6c returning a val 6b90: 75 65 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 ue. }.. pr 6ba0: 6f 63 20 5f 75 6d 6f 75 6e 74 20 7b 64 62 20 61 oc _umount {db a 6bb0: 72 67 73 7d 20 7b 0a 09 63 61 74 63 68 20 7b 61 rgs} {..catch {a 6bc0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 76 3a 3a fter cancel $v:: 6bd0: 74 69 6d 65 72 28 24 64 62 29 7d 0a 09 61 72 72 timer($db)}..arr 6be0: 61 79 20 75 6e 73 65 74 20 76 3a 3a 6d 6f 64 65 ay unset v::mode 6bf0: 20 24 64 62 0a 09 61 72 72 61 79 20 75 6e 73 65 $db..array unse 6c00: 74 20 76 3a 3a 74 69 6d 65 72 20 24 64 62 0a 09 t v::timer $db.. 6c10: 61 72 72 61 79 20 75 6e 73 65 74 20 76 3a 3a 63 array unset v::c 6c20: 61 63 68 65 20 24 64 62 2c 2a 0a 09 61 72 72 61 ache $db,*..arra 6c30: 79 20 75 6e 73 65 74 20 76 3a 3a 66 63 61 63 68 y unset v::fcach 6c40: 65 20 24 64 62 2e 2a 0a 09 72 65 61 64 6b 69 74 e $db.*..readkit 6c50: 3a 3a 66 69 6c 65 20 63 6c 6f 73 65 20 24 64 62 ::file close $db 6c60: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 . }.. proc 6c70: 20 73 74 61 74 20 7b 64 62 20 70 61 74 68 20 7b stat {db path { 6c80: 61 72 72 20 22 22 7d 7d 20 7b 0a 09 73 65 74 20 arr ""}} {..set 6c90: 73 70 20 5b 3a 3a 66 69 6c 65 20 73 70 6c 69 74 sp [::file split 6ca0: 20 24 70 61 74 68 5d 0a 09 73 65 74 20 74 61 69 $path]..set tai 6cb0: 6c 20 5b 6c 69 6e 64 65 78 20 24 73 70 20 65 6e l [lindex $sp en 6cc0: 64 5d 0a 0a 09 73 65 74 20 70 61 72 65 6e 74 20 d]...set parent 6cd0: 30 0a 09 73 65 74 20 76 69 65 77 20 24 64 62 2e 0..set view $db. 6ce0: 64 69 72 73 0a 09 73 65 74 20 74 79 70 65 20 64 dirs..set type d 6cf0: 69 72 65 63 74 6f 72 79 0a 0a 09 66 6f 72 65 61 irectory...forea 6d00: 63 68 20 65 6c 65 20 5b 6c 72 61 6e 67 65 20 24 ch ele [lrange $ 6d10: 73 70 20 30 20 65 6e 64 2d 31 5d 20 7b 0a 09 20 sp 0 end-1] {.. 6d20: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi 6d30: 73 74 73 20 76 3a 3a 63 61 63 68 65 28 24 64 62 sts v::cache($db 6d40: 2c 24 70 61 72 65 6e 74 2c 24 65 6c 65 29 5d 7d ,$parent,$ele)]} 6d50: 20 7b 0a 09 09 73 65 74 20 70 61 72 65 6e 74 20 {...set parent 6d60: 24 76 3a 3a 63 61 63 68 65 28 24 64 62 2c 24 70 $v::cache($db,$p 6d70: 61 72 65 6e 74 2c 24 65 6c 65 29 0a 09 20 20 20 arent,$ele).. 6d80: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 } else {...set 6d90: 72 6f 77 20 5b 72 65 61 64 6b 69 74 3a 3a 73 65 row [readkit::se 6da0: 6c 65 63 74 20 24 76 69 65 77 20 2d 63 6f 75 6e lect $view -coun 6db0: 74 20 31 20 70 61 72 65 6e 74 20 24 70 61 72 65 t 1 parent $pare 6dc0: 6e 74 20 6e 61 6d 65 20 24 65 6c 65 5d 0a 09 09 nt name $ele]... 6dd0: 69 66 20 7b 20 24 72 6f 77 20 3d 3d 20 22 22 20 if { $row == "" 6de0: 7d 20 7b 0a 09 09 20 20 20 20 76 66 73 3a 3a 66 } {... vfs::f 6df0: 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 65 ilesystem posixe 6e00: 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f 73 rror $::vfs::pos 6e10: 69 78 28 45 4e 4f 45 4e 54 29 0a 09 09 7d 0a 09 ix(ENOENT)...}.. 6e20: 09 73 65 74 20 76 3a 3a 63 61 63 68 65 28 24 64 .set v::cache($d 6e30: 62 2c 24 70 61 72 65 6e 74 2c 24 65 6c 65 29 20 b,$parent,$ele) 6e40: 24 72 6f 77 0a 09 09 73 65 74 20 70 61 72 65 6e $row...set paren 6e50: 74 20 24 72 6f 77 0a 09 20 20 20 20 7d 0a 09 7d t $row.. }..} 6e60: 0a 09 0a 09 23 20 4e 6f 77 20 63 68 65 63 6b 20 ....# Now check 6e70: 69 66 20 66 69 6e 61 6c 20 63 6f 6d 70 20 69 73 if final comp is 6e80: 20 61 20 64 69 72 65 63 74 6f 72 79 20 6f 72 20 a directory or 6e90: 61 20 66 69 6c 65 0a 09 23 20 43 41 43 48 49 4e a file..# CACHIN 6ea0: 47 20 69 73 20 72 65 71 75 69 72 65 64 20 2d 20 G is required - 6eb0: 69 74 20 63 61 6e 20 64 65 6c 69 76 65 72 20 61 it can deliver a 6ec0: 20 78 31 35 20 73 70 65 65 64 2d 75 70 21 0a 09 x15 speed-up!.. 6ed0: 0a 09 69 66 20 7b 20 5b 73 74 72 69 6e 67 20 65 ..if { [string e 6ee0: 71 75 61 6c 20 24 74 61 69 6c 20 22 2e 22 5d 20 qual $tail "."] 6ef0: 7c 7c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c || [string equal 6f00: 20 24 74 61 69 6c 20 22 3a 22 5d 20 5c 0a 09 20 $tail ":"] \.. 6f10: 20 7c 7c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 || [string equa 6f20: 6c 20 24 74 61 69 6c 20 22 22 5d 20 7d 20 7b 0a l $tail ""] } {. 6f30: 09 20 20 20 20 73 65 74 20 72 6f 77 20 24 70 61 . set row $pa 6f40: 72 65 6e 74 0a 0a 09 7d 20 65 6c 73 65 69 66 20 rent...} elseif 6f50: 7b 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 76 { [info exists v 6f60: 3a 3a 63 61 63 68 65 28 24 64 62 2c 24 70 61 72 ::cache($db,$par 6f70: 65 6e 74 2c 24 74 61 69 6c 29 5d 20 7d 20 7b 0a ent,$tail)] } {. 6f80: 09 20 20 20 20 73 65 74 20 72 6f 77 20 24 76 3a . set row $v: 6f90: 3a 63 61 63 68 65 28 24 64 62 2c 24 70 61 72 65 :cache($db,$pare 6fa0: 6e 74 2c 24 74 61 69 6c 29 0a 09 7d 20 65 6c 73 nt,$tail)..} els 6fb0: 65 20 7b 0a 09 20 20 20 20 23 20 46 69 6c 65 3f e {.. # File? 6fc0: 0a 09 20 20 20 20 73 65 74 20 66 76 69 65 77 20 .. set fview 6fd0: 24 76 69 65 77 21 24 70 61 72 65 6e 74 2e 66 69 $view!$parent.fi 6fe0: 6c 65 73 0a 09 20 20 20 20 23 20 63 72 65 61 74 les.. # creat 6ff0: 65 20 61 20 6e 61 6d 65 20 63 61 63 68 65 20 6f e a name cache o 7000: 66 20 66 69 6c 65 73 20 69 6e 20 74 68 69 73 20 f files in this 7010: 64 69 72 65 63 74 6f 72 79 0a 09 20 20 20 20 69 directory.. i 7020: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists 7030: 20 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 65 v::fcache($fvie 7040: 77 29 5d 7d 20 7b 0a 09 09 23 20 63 61 63 68 65 w)]} {...# cache 7050: 20 6f 6e 6c 79 20 61 20 6c 69 6d 69 74 65 64 20 only a limited 7060: 6e 75 6d 62 65 72 20 6f 66 20 64 69 72 65 63 74 number of direct 7070: 6f 72 69 65 73 0a 09 09 69 66 20 7b 5b 61 72 72 ories...if {[arr 7080: 61 79 20 73 69 7a 65 20 76 3a 3a 66 63 61 63 68 ay size v::fcach 7090: 65 5d 20 3e 3d 20 31 30 7d 20 7b 0a 09 09 20 20 e] >= 10} {... 70a0: 20 20 61 72 72 61 79 20 75 6e 73 65 74 20 76 3a array unset v: 70b0: 3a 66 63 61 63 68 65 20 2a 0a 09 09 7d 0a 09 09 :fcache *...}... 70c0: 73 65 74 20 76 3a 3a 66 63 61 63 68 65 28 24 66 set v::fcache($f 70d0: 76 69 65 77 29 20 7b 7d 0a 09 09 72 65 61 64 6b view) {}...readk 70e0: 69 74 3a 3a 6c 6f 6f 70 20 63 20 24 66 76 69 65 it::loop c $fvie 70f0: 77 20 7b 0a 09 09 20 20 20 20 6c 61 70 70 65 6e w {... lappen 7100: 64 20 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 d v::fcache($fvi 7110: 65 77 29 20 5b 72 65 61 64 6b 69 74 3a 3a 67 65 ew) [readkit::ge 7120: 74 20 24 63 20 6e 61 6d 65 5d 0a 09 09 7d 0a 09 t $c name]...}.. 7130: 20 20 20 20 7d 0a 09 20 20 20 20 73 65 74 20 72 }.. set r 7140: 6f 77 20 5b 6c 73 65 61 72 63 68 20 2d 65 78 61 ow [lsearch -exa 7150: 63 74 20 24 76 3a 3a 66 63 61 63 68 65 28 24 66 ct $v::fcache($f 7160: 76 69 65 77 29 20 24 74 61 69 6c 5d 0a 09 20 20 view) $tail].. 7170: 20 20 23 73 65 74 20 72 6f 77 20 5b 72 65 61 64 #set row [read 7180: 6b 69 74 3a 3a 73 65 6c 65 63 74 20 24 66 76 69 kit::select $fvi 7190: 65 77 20 2d 63 6f 75 6e 74 20 31 20 6e 61 6d 65 ew -count 1 name 71a0: 20 24 74 61 69 6c 5d 0a 09 20 20 20 20 23 69 66 $tail].. #if 71b0: 20 7b 24 72 6f 77 20 3d 3d 20 22 22 7d 20 7b 20 {$row == ""} { 71c0: 73 65 74 20 72 6f 77 20 2d 31 20 7d 0a 09 20 20 set row -1 }.. 71d0: 20 20 69 66 20 7b 20 24 72 6f 77 20 21 3d 20 2d if { $row != - 71e0: 31 20 7d 20 7b 0a 09 09 73 65 74 20 74 79 70 65 1 } {...set type 71f0: 20 66 69 6c 65 0a 09 09 73 65 74 20 76 69 65 77 file...set view 7200: 20 24 76 69 65 77 21 24 70 61 72 65 6e 74 2e 66 $view!$parent.f 7210: 69 6c 65 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 iles.. } else 7220: 20 7b 0a 09 09 23 20 44 69 72 65 63 74 6f 72 79 {...# Directory 7230: 3f 0a 09 09 73 65 74 20 72 6f 77 20 5b 72 65 61 ?...set row [rea 7240: 64 6b 69 74 3a 3a 73 65 6c 65 63 74 20 24 76 69 dkit::select $vi 7250: 65 77 20 2d 63 6f 75 6e 74 20 31 20 70 61 72 65 ew -count 1 pare 7260: 6e 74 20 24 70 61 72 65 6e 74 20 6e 61 6d 65 20 nt $parent name 7270: 24 74 61 69 6c 5d 0a 09 09 69 66 20 7b 20 24 72 $tail]...if { $r 7280: 6f 77 20 21 3d 20 22 22 20 7d 20 7b 0a 09 09 20 ow != "" } {... 7290: 20 20 20 73 65 74 20 76 3a 3a 63 61 63 68 65 28 set v::cache( 72a0: 24 64 62 2c 24 70 61 72 65 6e 74 2c 24 74 61 69 $db,$parent,$tai 72b0: 6c 29 20 24 72 6f 77 0a 09 09 7d 20 65 6c 73 65 l) $row...} else 72c0: 20 7b 20 0a 09 09 20 20 20 20 76 66 73 3a 3a 66 { ... vfs::f 72d0: 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 65 ilesystem posixe 72e0: 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f 73 rror $::vfs::pos 72f0: 69 78 28 45 4e 4f 45 4e 54 29 0a 09 09 7d 0a 09 ix(ENOENT)...}.. 7300: 20 20 20 20 7d 0a 09 7d 0a 20 0a 20 20 20 20 20 }..}. . 7310: 20 20 20 69 66 20 7b 21 5b 73 74 72 69 6e 67 20 if {![string 7320: 6c 65 6e 67 74 68 20 24 61 72 72 5d 7d 20 7b 0a length $arr]} {. 7330: 20 20 20 20 20 20 20 20 20 20 20 20 23 20 54 68 # Th 7340: 65 20 63 61 6c 6c 65 72 20 64 6f 65 73 6e 27 74 e caller doesn't 7350: 20 6e 65 65 64 20 6d 6f 72 65 20 64 65 74 61 69 need more detai 7360: 6c 65 64 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 2e led information. 7370: 0a 20 20 20 20 20 20 20 20 20 20 20 20 72 65 74 . ret 7380: 75 72 6e 20 31 0a 20 20 20 20 20 20 20 20 7d 0a urn 1. }. 7390: 20 0a 09 73 65 74 20 63 75 72 20 24 76 69 65 77 ..set cur $view 73a0: 21 24 72 6f 77 0a 0a 09 75 70 76 61 72 20 31 20 !$row...upvar 1 73b0: 24 61 72 72 20 73 62 0a 0a 09 73 65 74 20 73 62 $arr sb...set sb 73c0: 28 74 79 70 65 29 20 20 20 20 24 74 79 70 65 0a (type) $type. 73d0: 09 73 65 74 20 73 62 28 76 69 65 77 29 20 20 20 .set sb(view) 73e0: 20 24 76 69 65 77 0a 09 73 65 74 20 73 62 28 69 $view..set sb(i 73f0: 6e 6f 29 20 20 20 20 20 24 63 75 72 0a 0a 09 69 no) $cur...i 7400: 66 20 7b 20 5b 73 74 72 69 6e 67 20 65 71 75 61 f { [string equa 7410: 6c 20 24 74 79 70 65 20 22 64 69 72 65 63 74 6f l $type "directo 7420: 72 79 22 5d 20 7d 20 7b 0a 09 20 20 20 20 73 65 ry"] } {.. se 7430: 74 20 73 62 28 61 74 69 6d 65 29 20 30 0a 09 20 t sb(atime) 0.. 7440: 20 20 20 73 65 74 20 73 62 28 63 74 69 6d 65 29 set sb(ctime) 7450: 20 30 0a 09 20 20 20 20 73 65 74 20 73 62 28 67 0.. set sb(g 7460: 69 64 29 20 20 20 30 0a 09 20 20 20 20 73 65 74 id) 0.. set 7470: 20 73 62 28 6d 6f 64 65 29 20 20 30 37 37 37 0a sb(mode) 0777. 7480: 09 20 20 20 20 73 65 74 20 73 62 28 6d 74 69 6d . set sb(mtim 7490: 65 29 20 30 0a 09 20 20 20 20 73 65 74 20 73 62 e) 0.. set sb 74a0: 28 6e 6c 69 6e 6b 29 20 5b 65 78 70 72 20 7b 20 (nlink) [expr { 74b0: 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74 20 24 63 [readkit::get $c 74c0: 75 72 20 66 69 6c 65 73 5d 20 2b 20 31 20 7d 5d ur files] + 1 }] 74d0: 0a 09 20 20 20 20 73 65 74 20 73 62 28 73 69 7a .. set sb(siz 74e0: 65 29 20 20 30 0a 09 20 20 20 20 73 65 74 20 73 e) 0.. set s 74f0: 62 28 63 73 69 7a 65 29 20 30 0a 09 20 20 20 20 b(csize) 0.. 7500: 73 65 74 20 73 62 28 75 69 64 29 20 20 20 30 0a set sb(uid) 0. 7510: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 .} else {.. s 7520: 65 74 20 6d 74 69 6d 65 20 20 20 5b 72 65 61 64 et mtime [read 7530: 6b 69 74 3a 3a 67 65 74 20 24 63 75 72 20 64 61 kit::get $cur da 7540: 74 65 5d 0a 09 20 20 20 20 73 65 74 20 73 62 28 te].. set sb( 7550: 61 74 69 6d 65 29 20 24 6d 74 69 6d 65 0a 09 20 atime) $mtime.. 7560: 20 20 20 73 65 74 20 73 62 28 63 74 69 6d 65 29 set sb(ctime) 7570: 20 24 6d 74 69 6d 65 0a 09 20 20 20 20 73 65 74 $mtime.. set 7580: 20 73 62 28 67 69 64 29 20 20 20 30 0a 09 20 20 sb(gid) 0.. 7590: 20 20 73 65 74 20 73 62 28 6d 6f 64 65 29 20 20 set sb(mode) 75a0: 30 37 37 37 0a 09 20 20 20 20 73 65 74 20 73 62 0777.. set sb 75b0: 28 6d 74 69 6d 65 29 20 24 6d 74 69 6d 65 0a 09 (mtime) $mtime.. 75c0: 20 20 20 20 73 65 74 20 73 62 28 6e 6c 69 6e 6b set sb(nlink 75d0: 29 20 31 0a 09 20 20 20 20 73 65 74 20 73 62 28 ) 1.. set sb( 75e0: 73 69 7a 65 29 20 20 5b 72 65 61 64 6b 69 74 3a size) [readkit: 75f0: 3a 67 65 74 20 24 63 75 72 20 73 69 7a 65 5d 0a :get $cur size]. 7600: 09 20 20 20 20 73 65 74 20 73 62 28 63 73 69 7a . set sb(csiz 7610: 65 29 20 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74 e) [readkit::get 7620: 20 24 63 75 72 20 2d 73 69 7a 65 20 63 6f 6e 74 $cur -size cont 7630: 65 6e 74 73 5d 0a 09 20 20 20 20 73 65 74 20 73 ents].. set s 7640: 62 28 75 69 64 29 20 20 20 30 0a 09 7d 0a 20 20 b(uid) 0..}. 7650: 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 64 6f }.. proc do 7660: 5f 63 6c 6f 73 65 20 7b 64 62 20 66 64 20 6d 6f _close {db fd mo 7670: 64 65 20 63 75 72 7d 20 7b 0a 09 69 66 20 7b 21 de cur} {..if {! 7680: 5b 72 65 67 65 78 70 20 7b 5b 61 77 5d 7d 20 24 [regexp {[aw]} $ 7690: 6d 6f 64 65 5d 7d 20 7b 0a 09 20 20 20 20 65 72 mode]} {.. er 76a0: 72 6f 72 20 22 6d 6b 63 6c 5f 76 66 73 3a 3a 64 ror "mkcl_vfs::d 76b0: 6f 5f 63 6c 6f 73 65 20 63 61 6c 6c 65 64 20 77 o_close called w 76c0: 69 74 68 20 62 61 64 20 6d 6f 64 65 3a 20 24 6d ith bad mode: $m 76d0: 6f 64 65 22 0a 09 7d 0a 0a 09 72 65 61 64 6b 69 ode"..}...readki 76e0: 74 3a 3a 73 65 74 20 24 63 75 72 20 73 69 7a 65 t::set $cur size 76f0: 20 2d 31 20 64 61 74 65 20 5b 63 6c 6f 63 6b 20 -1 date [clock 7700: 73 65 63 6f 6e 64 73 5d 0a 09 66 6c 75 73 68 20 seconds]..flush 7710: 24 66 64 0a 09 69 66 20 7b 20 5b 73 74 72 69 6e $fd..if { [strin 7720: 67 20 6d 61 74 63 68 20 2a 7a 2a 20 24 6d 6f 64 g match *z* $mod 7730: 65 5d 20 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e e] } {.. fcon 7740: 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 6e figure $fd -tran 7750: 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a 09 slation binary.. 7760: 20 20 20 20 73 65 65 6b 20 24 66 64 20 30 0a 09 seek $fd 0.. 7770: 20 20 20 20 73 65 74 20 64 61 74 61 20 5b 72 65 set data [re 7780: 61 64 20 24 66 64 5d 0a 09 20 20 20 20 73 65 74 ad $fd].. set 7790: 20 63 64 61 74 61 20 5b 76 66 73 3a 3a 7a 69 70 cdata [vfs::zip 77a0: 20 2d 6d 6f 64 65 20 63 6f 6d 70 72 65 73 73 20 -mode compress 77b0: 24 64 61 74 61 5d 0a 09 20 20 20 20 73 65 74 20 $data].. set 77c0: 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 len [string leng 77d0: 74 68 20 24 64 61 74 61 5d 0a 09 20 20 20 20 73 th $data].. s 77e0: 65 74 20 63 6c 65 6e 20 5b 73 74 72 69 6e 67 20 et clen [string 77f0: 6c 65 6e 67 74 68 20 24 63 64 61 74 61 5d 0a 09 length $cdata].. 7800: 20 20 20 20 69 66 20 7b 20 24 63 6c 65 6e 20 3c if { $clen < 7810: 20 24 6c 65 6e 20 7d 20 7b 0a 09 09 72 65 61 64 $len } {...read 7820: 6b 69 74 3a 3a 73 65 74 20 24 63 75 72 20 73 69 kit::set $cur si 7830: 7a 65 20 24 6c 65 6e 20 63 6f 6e 74 65 6e 74 73 ze $len contents 7840: 20 24 63 64 61 74 61 0a 09 20 20 20 20 7d 20 65 $cdata.. } e 7850: 6c 73 65 20 7b 0a 09 09 72 65 61 64 6b 69 74 3a lse {...readkit: 7860: 3a 73 65 74 20 24 63 75 72 20 73 69 7a 65 20 24 :set $cur size $ 7870: 6c 65 6e 20 63 6f 6e 74 65 6e 74 73 20 24 64 61 len contents $da 7880: 74 61 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 ta.. }..} els 7890: 65 20 7b 0a 09 20 20 20 20 72 65 61 64 6b 69 74 e {.. readkit 78a0: 3a 3a 73 65 74 20 24 63 75 72 20 73 69 7a 65 20 ::set $cur size 78b0: 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74 20 24 63 [readkit::get $c 78c0: 75 72 20 2d 73 69 7a 65 20 63 6f 6e 74 65 6e 74 ur -size content 78d0: 73 5d 0a 09 7d 0a 09 23 20 31 36 6f 63 74 30 32 s]..}..# 16oct02 78e0: 20 6e 65 77 20 6c 6f 67 69 63 20 74 6f 20 73 74 new logic to st 78f0: 61 72 74 20 61 20 70 65 72 69 6f 64 69 63 20 63 art a periodic c 7900: 6f 6d 6d 69 74 20 74 69 6d 65 72 20 69 66 20 6e ommit timer if n 7910: 6f 74 20 79 65 74 20 72 75 6e 6e 69 6e 67 0a 09 ot yet running.. 7920: 73 65 74 75 70 43 6f 6d 6d 69 74 73 20 24 64 62 setupCommits $db 7930: 0a 09 72 65 74 75 72 6e 20 22 22 0a 20 20 20 20 ..return "". 7940: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 73 65 74 75 }.. proc setu 7950: 70 43 6f 6d 6d 69 74 73 20 7b 64 62 7d 20 7b 0a pCommits {db} {. 7960: 09 69 66 20 7b 24 76 3a 3a 6d 6f 64 65 28 24 64 .if {$v::mode($d 7970: 62 29 20 65 71 20 22 72 65 61 64 77 72 69 74 65 b) eq "readwrite 7980: 22 20 26 26 20 21 5b 69 6e 66 6f 20 65 78 69 73 " && ![info exis 7990: 74 73 20 76 3a 3a 74 69 6d 65 72 28 24 64 62 29 ts v::timer($db) 79a0: 5d 7d 20 7b 0a 09 20 20 20 20 70 65 72 69 6f 64 ]} {.. period 79b0: 69 63 43 6f 6d 6d 69 74 20 24 64 62 0a 09 20 20 icCommit $db.. 79c0: 20 20 72 65 61 64 6b 69 74 3a 3a 66 69 6c 65 20 readkit::file 79d0: 61 75 74 6f 63 6f 6d 6d 69 74 20 24 64 62 0a 09 autocommit $db.. 79e0: 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f }. }.. pro 79f0: 63 20 6d 6b 64 69 72 20 7b 64 62 20 70 61 74 68 c mkdir {db path 7a00: 7d 20 7b 0a 09 69 66 20 7b 24 76 3a 3a 6d 6f 64 } {..if {$v::mod 7a10: 65 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 6f e($db) == "reado 7a20: 6e 6c 79 22 7d 20 7b 0a 09 20 20 20 20 76 66 73 nly"} {.. vfs 7a30: 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 ::filesystem pos 7a40: 69 78 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a ixerror $::vfs:: 7a50: 70 6f 73 69 78 28 45 52 4f 46 53 29 0a 09 7d 0a posix(EROFS)..}. 7a60: 09 73 65 74 20 73 70 20 5b 3a 3a 66 69 6c 65 20 .set sp [::file 7a70: 73 70 6c 69 74 20 24 70 61 74 68 5d 0a 09 73 65 split $path]..se 7a80: 74 20 70 61 72 65 6e 74 20 30 0a 09 73 65 74 20 t parent 0..set 7a90: 76 69 65 77 20 24 64 62 2e 64 69 72 73 0a 0a 09 view $db.dirs... 7aa0: 73 65 74 20 6e 70 61 74 68 20 7b 7d 0a 09 23 20 set npath {}..# 7ab0: 54 68 69 73 20 61 63 74 75 61 6c 6c 79 20 64 6f This actually do 7ac0: 65 73 20 6d 6f 72 65 20 77 6f 72 6b 20 74 68 61 es more work tha 7ad0: 6e 20 69 73 20 6e 65 65 64 65 64 2e 20 54 63 6c n is needed. Tcl 7ae0: 27 73 0a 09 23 20 76 66 73 20 6f 6e 6c 79 20 72 's..# vfs only r 7af0: 65 71 75 69 72 65 73 20 75 73 20 74 6f 20 63 72 equires us to cr 7b00: 65 61 74 65 20 74 68 65 20 6c 61 73 74 20 70 69 eate the last pi 7b10: 65 63 65 2c 20 61 6e 64 0a 09 23 20 54 63 6c 20 ece, and..# Tcl 7b20: 61 6c 72 65 61 64 79 20 6b 6e 6f 77 73 20 69 74 already knows it 7b30: 20 69 73 20 6e 6f 74 20 61 20 66 69 6c 65 2e 0a is not a file.. 7b40: 09 66 6f 72 65 61 63 68 20 65 6c 65 20 24 73 70 .foreach ele $sp 7b50: 20 7b 0a 09 20 20 20 20 73 65 74 20 6e 70 61 74 {.. set npat 7b60: 68 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 6e 70 h [file join $np 7b70: 61 74 68 20 24 65 6c 65 5d 0a 0a 09 20 20 20 20 ath $ele]... 7b80: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 74 61 if {![catch {sta 7b90: 74 20 24 64 62 20 24 6e 70 61 74 68 20 73 62 7d t $db $npath sb} 7ba0: 5d 20 7d 20 7b 0a 09 09 69 66 20 7b 20 24 73 62 ] } {...if { $sb 7bb0: 28 74 79 70 65 29 20 21 3d 20 22 64 69 72 65 63 (type) != "direc 7bc0: 74 6f 72 79 22 20 7d 20 7b 0a 09 09 20 20 20 20 tory" } {... 7bd0: 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20 vfs::filesystem 7be0: 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a 76 66 posixerror $::vf 7bf0: 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53 29 0a s::posix(EROFS). 7c00: 09 09 7d 0a 09 09 73 65 74 20 70 61 72 65 6e 74 ..}...set parent 7c10: 20 5b 72 65 61 64 6b 69 74 3a 3a 63 75 72 73 6f [readkit::curso 7c20: 72 20 70 6f 73 69 74 69 6f 6e 20 73 62 28 69 6e r position sb(in 7c30: 6f 29 5d 0a 09 09 63 6f 6e 74 69 6e 75 65 0a 09 o)]...continue.. 7c40: 20 20 20 20 7d 0a 09 20 20 20 20 23 73 65 74 20 }.. #set 7c50: 70 61 72 65 6e 74 20 5b 72 65 61 64 6b 69 74 3a parent [readkit: 7c60: 3a 63 75 72 73 6f 72 20 70 6f 73 69 74 69 6f 6e :cursor position 7c70: 20 73 62 28 69 6e 6f 29 5d 0a 09 20 20 20 20 73 sb(ino)].. s 7c80: 65 74 20 63 75 72 20 5b 72 65 61 64 6b 69 74 3a et cur [readkit: 7c90: 3a 72 6f 77 20 61 70 70 65 6e 64 20 24 76 69 65 :row append $vie 7ca0: 77 20 6e 61 6d 65 20 24 65 6c 65 20 70 61 72 65 w name $ele pare 7cb0: 6e 74 20 24 70 61 72 65 6e 74 5d 0a 09 20 20 20 nt $parent].. 7cc0: 20 73 65 74 20 70 61 72 65 6e 74 20 5b 72 65 61 set parent [rea 7cd0: 64 6b 69 74 3a 3a 63 75 72 73 6f 72 20 70 6f 73 dkit::cursor pos 7ce0: 69 74 69 6f 6e 20 63 75 72 5d 0a 09 7d 0a 09 73 ition cur]..}..s 7cf0: 65 74 75 70 43 6f 6d 6d 69 74 73 20 24 64 62 0a etupCommits $db. 7d00: 09 72 65 74 75 72 6e 20 22 22 0a 20 20 20 20 7d .return "". } 7d10: 0a 0a 20 20 20 20 70 72 6f 63 20 67 65 74 64 69 .. proc getdi 7d20: 72 20 7b 64 62 20 70 61 74 68 20 7b 70 61 74 20 r {db path {pat 7d30: 2a 7d 7d 20 7b 0a 09 69 66 20 7b 5b 63 61 74 63 *}} {..if {[catc 7d40: 68 20 7b 20 73 74 61 74 20 24 64 62 20 24 70 61 h { stat $db $pa 7d50: 74 68 20 73 62 20 7d 5d 20 7c 7c 20 24 73 62 28 th sb }] || $sb( 7d60: 74 79 70 65 29 20 21 3d 20 22 64 69 72 65 63 74 type) != "direct 7d70: 6f 72 79 22 20 7d 20 7b 0a 09 20 20 20 20 72 65 ory" } {.. re 7d80: 74 75 72 6e 0a 09 7d 0a 0a 09 23 20 4d 61 74 63 turn..}...# Matc 7d90: 68 20 64 69 72 65 63 74 6f 72 69 65 73 0a 09 73 h directories..s 7da0: 65 74 20 70 61 72 65 6e 74 20 5b 72 65 61 64 6b et parent [readk 7db0: 69 74 3a 3a 63 75 72 73 6f 72 20 70 6f 73 69 74 it::cursor posit 7dc0: 69 6f 6e 20 73 62 28 69 6e 6f 29 5d 20 0a 09 66 ion sb(ino)] ..f 7dd0: 6f 72 65 61 63 68 20 72 6f 77 20 5b 72 65 61 64 oreach row [read 7de0: 6b 69 74 3a 3a 73 65 6c 65 63 74 20 24 73 62 28 kit::select $sb( 7df0: 76 69 65 77 29 20 70 61 72 65 6e 74 20 24 70 61 view) parent $pa 7e00: 72 65 6e 74 20 2d 67 6c 6f 62 20 6e 61 6d 65 20 rent -glob name 7e10: 24 70 61 74 5d 20 7b 0a 09 20 20 20 20 73 65 74 $pat] {.. set 7e20: 20 68 69 74 73 28 5b 72 65 61 64 6b 69 74 3a 3a hits([readkit:: 7e30: 67 65 74 20 24 73 62 28 76 69 65 77 29 21 24 72 get $sb(view)!$r 7e40: 6f 77 20 6e 61 6d 65 5d 29 20 31 0a 09 7d 0a 09 ow name]) 1..}.. 7e50: 23 20 4d 61 74 63 68 20 66 69 6c 65 73 0a 09 73 # Match files..s 7e60: 65 74 20 76 69 65 77 20 24 73 62 28 76 69 65 77 et view $sb(view 7e70: 29 21 24 70 61 72 65 6e 74 2e 66 69 6c 65 73 0a )!$parent.files. 7e80: 09 66 6f 72 65 61 63 68 20 72 6f 77 20 5b 72 65 .foreach row [re 7e90: 61 64 6b 69 74 3a 3a 73 65 6c 65 63 74 20 24 76 adkit::select $v 7ea0: 69 65 77 20 2d 67 6c 6f 62 20 6e 61 6d 65 20 24 iew -glob name $ 7eb0: 70 61 74 5d 20 7b 0a 09 20 20 20 20 73 65 74 20 pat] {.. set 7ec0: 68 69 74 73 28 5b 72 65 61 64 6b 69 74 3a 3a 67 hits([readkit::g 7ed0: 65 74 20 24 76 69 65 77 21 24 72 6f 77 20 6e 61 et $view!$row na 7ee0: 6d 65 5d 29 20 31 0a 09 7d 0a 09 72 65 74 75 72 me]) 1..}..retur 7ef0: 6e 20 5b 6c 73 6f 72 74 20 5b 61 72 72 61 79 20 n [lsort [array 7f00: 6e 61 6d 65 73 20 68 69 74 73 5d 5d 0a 20 20 20 names hits]]. 7f10: 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 74 69 }.. proc mti 7f20: 6d 65 20 7b 64 62 20 70 61 74 68 20 74 69 6d 65 me {db path time 7f30: 7d 20 7b 0a 09 69 66 20 7b 24 76 3a 3a 6d 6f 64 } {..if {$v::mod 7f40: 65 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 6f e($db) == "reado 7f50: 6e 6c 79 22 7d 20 7b 0a 09 20 20 20 20 76 66 73 nly"} {.. vfs 7f60: 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 ::filesystem pos 7f70: 69 78 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a ixerror $::vfs:: 7f80: 70 6f 73 69 78 28 45 52 4f 46 53 29 0a 09 7d 0a posix(EROFS)..}. 7f90: 09 73 74 61 74 20 24 64 62 20 24 70 61 74 68 20 .stat $db $path 7fa0: 73 62 0a 09 69 66 20 7b 20 24 73 62 28 74 79 70 sb..if { $sb(typ 7fb0: 65 29 20 3d 3d 20 22 66 69 6c 65 22 20 7d 20 7b e) == "file" } { 7fc0: 0a 09 20 20 20 20 72 65 61 64 6b 69 74 3a 3a 73 .. readkit::s 7fd0: 65 74 20 24 73 62 28 69 6e 6f 29 20 64 61 74 65 et $sb(ino) date 7fe0: 20 24 74 69 6d 65 0a 09 7d 0a 09 72 65 74 75 72 $time..}..retur 7ff0: 6e 20 24 74 69 6d 65 0a 20 20 20 20 7d 0a 0a 20 n $time. }.. 8000: 20 20 20 70 72 6f 63 20 64 65 6c 65 74 65 20 7b proc delete { 8010: 64 62 20 70 61 74 68 20 7b 72 65 63 75 72 73 69 db path {recursi 8020: 76 65 20 30 7d 7d 20 7b 0a 09 23 70 75 74 73 20 ve 0}} {..#puts 8030: 73 74 64 65 72 72 20 22 6d 6b 34 64 65 6c 65 74 stderr "mk4delet 8040: 65 20 64 62 20 24 64 62 20 70 61 74 68 20 24 70 e db $db path $p 8050: 61 74 68 20 72 65 63 75 72 73 69 76 65 20 24 72 ath recursive $r 8060: 65 63 75 72 73 69 76 65 22 0a 09 69 66 20 7b 24 ecursive"..if {$ 8070: 76 3a 3a 6d 6f 64 65 28 24 64 62 29 20 3d 3d 20 v::mode($db) == 8080: 22 72 65 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 20 "readonly"} {.. 8090: 20 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 vfs::filesyst 80a0: 65 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 24 3a em posixerror $: 80b0: 3a 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 :vfs::posix(EROF 80c0: 53 29 0a 09 7d 0a 09 73 74 61 74 20 24 64 62 20 S)..}..stat $db 80d0: 24 70 61 74 68 20 73 62 0a 09 69 66 20 7b 24 73 $path sb..if {$s 80e0: 62 28 74 79 70 65 29 20 3d 3d 20 22 66 69 6c 65 b(type) == "file 80f0: 22 20 7d 20 7b 0a 09 20 20 20 20 72 65 61 64 6b " } {.. readk 8100: 69 74 3a 3a 72 6f 77 20 64 65 6c 65 74 65 20 24 it::row delete $ 8110: 73 62 28 69 6e 6f 29 0a 09 20 20 20 20 69 66 20 sb(ino).. if 8120: 7b 5b 72 65 67 65 78 70 20 7b 28 2e 2a 29 21 28 {[regexp {(.*)!( 8130: 5c 64 2b 29 7d 20 24 73 62 28 69 6e 6f 29 20 2d \d+)} $sb(ino) - 8140: 20 76 20 72 5d 20 5c 0a 09 09 20 20 20 20 26 26 v r] \... && 8150: 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 76 3a [info exists v: 8160: 3a 66 63 61 63 68 65 28 24 76 29 5d 7d 20 7b 0a :fcache($v)]} {. 8170: 09 09 73 65 74 20 76 3a 3a 66 63 61 63 68 65 28 ..set v::fcache( 8180: 24 76 29 20 5b 6c 72 65 70 6c 61 63 65 20 24 76 $v) [lreplace $v 8190: 3a 3a 66 63 61 63 68 65 28 24 76 29 20 24 72 20 ::fcache($v) $r 81a0: 24 72 5d 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c $r].. }..} el 81b0: 73 65 20 7b 0a 09 20 20 20 20 23 20 6a 75 73 74 se {.. # just 81c0: 20 6d 61 72 6b 20 64 69 72 73 20 61 73 20 64 65 mark dirs as de 81d0: 6c 65 74 65 64 0a 09 20 20 20 20 73 65 74 20 63 leted.. set c 81e0: 6f 6e 74 65 6e 74 73 20 5b 67 65 74 64 69 72 20 ontents [getdir 81f0: 24 64 62 20 24 70 61 74 68 20 2a 5d 0a 09 20 20 $db $path *].. 8200: 20 20 69 66 20 7b 24 72 65 63 75 72 73 69 76 65 if {$recursive 8210: 7d 20 7b 0a 09 09 23 20 57 65 20 68 61 76 65 20 } {...# We have 8220: 74 6f 20 64 65 6c 65 74 65 20 74 68 65 73 65 20 to delete these 8230: 6d 61 6e 75 61 6c 6c 79 2c 20 65 6c 73 65 0a 09 manually, else.. 8240: 09 23 20 74 68 65 79 20 28 6f 72 20 74 68 65 69 .# they (or thei 8250: 72 20 63 61 63 68 65 29 20 6d 61 79 20 63 6f 6e r cache) may con 8260: 66 6c 69 63 74 20 77 69 74 68 0a 09 09 23 20 73 flict with...# s 8270: 6f 6d 65 74 68 69 6e 67 20 6c 61 74 65 72 0a 09 omething later.. 8280: 09 66 6f 72 65 61 63 68 20 66 20 24 63 6f 6e 74 .foreach f $cont 8290: 65 6e 74 73 20 7b 0a 09 09 20 20 20 20 64 65 6c ents {... del 82a0: 65 74 65 20 24 64 62 20 5b 66 69 6c 65 20 6a 6f ete $db [file jo 82b0: 69 6e 20 24 70 61 74 68 20 24 66 5d 20 24 72 65 in $path $f] $re 82c0: 63 75 72 73 69 76 65 0a 09 09 7d 0a 09 20 20 20 cursive...}.. 82d0: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 69 66 20 7b } else {...if { 82e0: 5b 6c 6c 65 6e 67 74 68 20 24 63 6f 6e 74 65 6e [llength $conten 82f0: 74 73 5d 7d 20 7b 0a 09 09 20 20 20 20 76 66 73 ts]} {... vfs 8300: 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 ::filesystem pos 8310: 69 78 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a ixerror $::vfs:: 8320: 70 6f 73 69 78 28 45 4e 4f 54 45 4d 50 54 59 29 posix(ENOTEMPTY) 8330: 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 ...}.. }.. 8340: 20 61 72 72 61 79 20 75 6e 73 65 74 20 76 3a 3a array unset v:: 8350: 63 61 63 68 65 20 5c 0a 09 09 20 20 20 20 22 24 cache \... "$ 8360: 64 62 2c 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74 db,[readkit::get 8370: 20 24 73 62 28 69 6e 6f 29 20 70 61 72 65 6e 74 $sb(ino) parent 8380: 5d 2c 5b 66 69 6c 65 20 74 61 69 6c 20 24 70 61 ],[file tail $pa 8390: 74 68 5d 22 0a 09 20 20 20 20 0a 09 20 20 20 20 th]".. .. 83a0: 23 20 66 6c 61 67 20 77 69 74 68 20 2d 39 39 2c # flag with -99, 83b0: 20 62 65 63 61 75 73 65 20 70 61 72 65 6e 74 20 because parent 83c0: 2d 31 20 69 73 20 6e 6f 74 20 72 65 73 65 72 76 -1 is not reserv 83d0: 65 64 20 66 6f 72 20 74 68 65 20 72 6f 6f 74 20 ed for the root 83e0: 64 69 72 0a 09 20 20 20 20 23 20 64 65 6c 65 74 dir.. # delet 83f0: 65 64 20 65 6e 74 72 69 65 73 20 6e 65 76 65 72 ed entries never 8400: 20 67 65 74 20 72 65 2d 75 73 65 64 2c 20 73 68 get re-used, sh 8410: 6f 75 6c 64 20 62 65 20 63 6c 65 61 6e 65 64 20 ould be cleaned 8420: 75 70 20 6f 6e 65 20 64 61 79 0a 09 20 20 20 20 up one day.. 8430: 72 65 61 64 6b 69 74 3a 3a 73 65 74 20 24 73 62 readkit::set $sb 8440: 28 69 6e 6f 29 20 70 61 72 65 6e 74 20 2d 39 39 (ino) parent -99 8450: 20 6e 61 6d 65 20 22 22 0a 09 20 20 20 20 23 20 name "".. # 8460: 67 65 74 20 72 69 64 20 6f 66 20 66 69 6c 65 20 get rid of file 8470: 65 6e 74 72 69 65 73 20 74 6f 20 72 65 6c 65 61 entries to relea 8480: 73 65 20 74 68 65 20 73 70 61 63 65 20 69 6e 20 se the space in 8490: 74 68 65 20 64 61 74 61 66 69 6c 65 0a 09 20 20 the datafile.. 84a0: 20 20 72 65 61 64 6b 69 74 3a 3a 76 69 65 77 20 readkit::view 84b0: 73 69 7a 65 20 24 73 62 28 69 6e 6f 29 2e 66 69 size $sb(ino).fi 84c0: 6c 65 73 20 30 0a 09 7d 0a 09 73 65 74 75 70 43 les 0..}..setupC 84d0: 6f 6d 6d 69 74 73 20 24 64 62 0a 09 72 65 74 75 ommits $db..retu 84e0: 72 6e 20 22 22 0a 20 20 20 20 7d 0a 7d 0a 0a 70 rn "". }.}..p 84f0: 61 63 6b 61 67 65 20 70 72 6f 76 69 64 65 20 72 ackage provide r 8500: 65 61 64 6b 69 74 20 30 2e 38 0a 70 61 63 6b 61 eadkit 0.8.packa 8510: 67 65 20 70 72 6f 76 69 64 65 20 76 66 73 3a 3a ge provide vfs:: 8520: 6d 6b 63 6c 20 32 2e 34 2e 30 2e 31 0a mkcl 2.4.0.1.