Hex Artifact Content

Artifact 122176da293daccca87927a43fa6a0e4640dc94e:


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.