Hex Artifact Content

Artifact 320b85c04296d4f61bcc98e21fb52e7480b4fcc2:


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 69 66 20 7b 24 73 69 7a 65 64 7d 20 7b 0a 09   if {$sized} {..
35d0: 09 6c 61 70 70 65 6e 64 20 72 20 5b 73 74 72 69  .lappend r [stri
35e0: 6e 67 20 6c 65 6e 67 74 68 20 24 76 5d 0a 09 20  ng length $v].. 
35f0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 6c 61     } else {...la
3600: 70 70 65 6e 64 20 72 20 24 76 0a 09 20 20 20 20  ppend r $v..    
3610: 7d 0a 09 7d 0a 09 69 66 20 7b 5b 6c 6c 65 6e 67  }..}..if {[lleng
3620: 74 68 20 24 61 72 67 73 5d 20 3d 3d 20 31 7d 20  th $args] == 1} 
3630: 7b 0a 09 20 20 20 20 73 65 74 20 72 20 5b 6c 69  {..    set r [li
3640: 6e 64 65 78 20 24 72 20 30 5d 0a 09 7d 0a 0a 09  ndex $r 0]..}...
3650: 72 65 74 75 72 6e 20 24 72 0a 20 20 20 20 7d 0a  return $r.    }.
3660: 0a 20 20 20 20 70 72 6f 63 20 6d 6b 5f 6c 6f 6f  .    proc mk_loo
3670: 70 20 7b 63 75 72 73 6f 72 20 70 61 74 68 20 61  p {cursor path a
3680: 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65  rgs} {.#set inde
3690: 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61  nt [string repea
36a0: 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c  t "    " [info l
36b0: 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64  evel]].#puts std
36c0: 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45  err "${indent}DE
36d0: 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a 6c 6f  BUG: readkit::lo
36e0: 6f 70 20 24 63 75 72 73 6f 72 20 24 70 61 74 68  op $cursor $path
36f0: 20 2e 2e 2e 22 0a 09 75 70 76 61 72 20 24 63 75   ..."..upvar $cu
3700: 72 73 6f 72 20 76 0a 09 69 66 20 7b 5b 6c 6c 65  rsor v..if {[lle
3710: 6e 67 74 68 20 24 61 72 67 73 5d 20 3d 3d 20 30  ngth $args] == 0
3720: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 61 72 67  } {..    set arg
3730: 73 20 5b 6c 69 73 74 20 24 70 61 74 68 5d 0a 09  s [list $path]..
3740: 20 20 20 20 73 65 74 20 70 61 74 68 20 24 76 0a      set path $v.
3750: 09 20 20 20 20 72 65 67 73 75 62 20 7b 21 2d 3f  .    regsub {!-?
3760: 5c 64 2b 24 7d 20 24 70 61 74 68 20 7b 7d 20 70  \d+$} $path {} p
3770: 61 74 68 0a 09 7d 0a 09 6c 61 73 73 69 67 6e 20  ath..}..lassign 
3780: 24 61 72 67 73 20 61 31 20 61 32 20 61 33 20 61  $args a1 a2 a3 a
3790: 34 0a 09 73 65 74 20 72 6f 77 72 65 66 20 5b 61  4..set rowref [a
37a0: 63 63 65 73 73 20 24 70 61 74 68 5d 0a 09 73 65  ccess $path]..se
37b0: 74 20 66 69 72 73 74 20 30 0a 09 73 65 74 20 6c  t first 0..set l
37c0: 69 6d 69 74 20 5b 76 6c 65 6e 20 24 72 6f 77 72  imit [vlen $rowr
37d0: 65 66 5d 0a 09 73 65 74 20 73 74 65 70 20 31 0a  ef]..set step 1.
37e0: 09 73 77 69 74 63 68 20 5b 6c 6c 65 6e 67 74 68  .switch [llength
37f0: 20 24 61 72 67 73 5d 20 7b 0a 09 20 20 20 20 31   $args] {..    1
3800: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 62 6f 64   {...    set bod
3810: 79 20 24 61 31 0a 09 09 7d 0a 09 20 20 20 20 32  y $a1...}..    2
3820: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 66 69 72   {...    set fir
3830: 73 74 20 24 61 31 0a 09 09 20 20 20 20 73 65 74  st $a1...    set
3840: 20 62 6f 64 79 20 24 61 32 0a 09 09 7d 0a 09 20   body $a2...}.. 
3850: 20 20 20 33 20 7b 0a 09 09 20 20 20 20 73 65 74     3 {...    set
3860: 20 66 69 72 73 74 20 24 61 31 0a 09 09 20 20 20   first $a1...   
3870: 20 73 65 74 20 6c 69 6d 69 74 20 24 61 32 0a 09   set limit $a2..
3880: 09 20 20 20 20 73 65 74 20 62 6f 64 79 20 24 61  .    set body $a
3890: 33 0a 09 09 7d 0a 09 20 20 20 20 34 20 7b 0a 09  3...}..    4 {..
38a0: 09 20 20 20 20 73 65 74 20 66 69 72 73 74 20 24  .    set first $
38b0: 61 31 0a 09 09 20 20 20 20 73 65 74 20 6c 69 6d  a1...    set lim
38c0: 69 74 20 24 61 32 0a 09 09 20 20 20 20 73 65 74  it $a2...    set
38d0: 20 73 74 65 70 20 24 61 33 0a 09 09 20 20 20 20   step $a3...    
38e0: 73 65 74 20 62 6f 64 79 20 24 61 34 0a 09 09 7d  set body $a4...}
38f0: 0a 09 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a  ..    default {.
3900: 09 09 20 20 20 20 65 72 72 6f 72 20 22 6d 6b 5f  ..    error "mk_
3910: 6c 6f 6f 70 20 61 72 67 20 63 6f 75 6e 74 3f 22  loop arg count?"
3920: 0a 09 09 7d 0a 09 7d 0a 09 73 65 74 20 63 6f 64  ...}..}..set cod
3930: 65 20 30 0a 09 66 6f 72 20 7b 73 65 74 20 69 20  e 0..for {set i 
3940: 24 66 69 72 73 74 7d 20 7b 24 69 20 3c 20 24 6c  $first} {$i < $l
3950: 69 6d 69 74 7d 20 7b 69 6e 63 72 20 69 20 24 73  imit} {incr i $s
3960: 74 65 70 7d 20 7b 0a 09 20 20 20 20 73 65 74 20  tep} {..    set 
3970: 76 20 24 70 61 74 68 21 24 69 0a 09 20 20 20 20  v $path!$i..    
3980: 73 65 74 20 63 6f 64 65 20 5b 63 61 74 63 68 20  set code [catch 
3990: 5b 6c 69 73 74 20 75 70 6c 65 76 65 6c 20 31 20  [list uplevel 1 
39a0: 24 62 6f 64 79 5d 20 65 72 72 5d 0a 09 20 20 20  $body] err]..   
39b0: 20 73 77 69 74 63 68 20 24 63 6f 64 65 20 7b 0a   switch $code {.
39c0: 09 09 31 20 2d 0a 09 09 32 20 7b 0a 09 09 09 72  ..1 -...2 {....r
39d0: 65 74 75 72 6e 20 2d 63 6f 64 65 20 24 63 6f 64  eturn -code $cod
39e0: 65 20 24 65 72 72 0a 09 09 20 20 20 20 7d 0a 09  e $err...    }..
39f0: 09 33 20 7b 0a 09 09 09 62 72 65 61 6b 0a 09 09  .3 {....break...
3a00: 20 20 20 20 7d 0a 09 20 20 20 20 7d 0a 09 7d 0a      }..    }..}.
3a10: 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20      }..    proc 
3a20: 6d 6b 5f 73 65 6c 65 63 74 20 7b 70 61 74 68 20  mk_select {path 
3a30: 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e 64  args} {.#set ind
3a40: 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 65  ent [string repe
3a50: 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f 20  at "    " [info 
3a60: 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74  level]].#puts st
3a70: 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44  derr "${indent}D
3a80: 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a 73  EBUG: readkit::s
3a90: 65 6c 65 63 74 20 24 70 61 74 68 20 24 61 72 67  elect $path $arg
3aa0: 73 22 0a 09 23 20 6f 6e 6c 79 20 68 61 6e 64 6c  s"..# only handl
3ab0: 65 20 74 68 65 20 73 69 6d 70 6c 65 73 74 20 63  e the simplest c
3ac0: 61 73 65 3a 20 65 78 61 63 74 20 6d 61 74 63 68  ase: exact match
3ad0: 65 73 0a 09 69 66 20 7b 5b 6c 69 6e 64 65 78 20  es..if {[lindex 
3ae0: 24 61 72 67 73 20 30 5d 20 3d 3d 20 22 2d 63 6f  $args 0] == "-co
3af0: 75 6e 74 22 7d 20 7b 0a 09 09 73 65 74 20 6d 61  unt"} {...set ma
3b00: 78 69 74 65 6d 73 20 5b 6c 69 6e 64 65 78 20 24  xitems [lindex $
3b10: 61 72 67 73 20 31 5d 0a 09 09 73 65 74 20 61 72  args 1]...set ar
3b20: 67 73 20 5b 6c 72 61 6e 67 65 20 24 61 72 67 73  gs [lrange $args
3b30: 20 32 20 65 6e 64 5d 0a 09 7d 0a 0a 09 73 65 74   2 end]..}...set
3b40: 20 63 75 72 72 6d 61 74 63 68 6d 6f 64 65 20 22   currmatchmode "
3b50: 63 61 73 65 69 6e 73 65 6e 73 69 74 69 76 65 22  caseinsensitive"
3b60: 0a 0a 09 73 65 74 20 6b 65 79 73 20 7b 7d 0a 09  ...set keys {}..
3b70: 73 65 74 20 76 61 6c 75 65 20 7b 7d 0a 09 73 65  set value {}..se
3b80: 74 20 6d 61 74 63 68 6d 6f 64 65 73 20 7b 7d 0a  t matchmodes {}.
3b90: 09 66 6f 72 20 7b 73 65 74 20 69 64 78 20 30 7d  .for {set idx 0}
3ba0: 20 7b 24 69 64 78 20 3c 20 5b 6c 6c 65 6e 67 74   {$idx < [llengt
3bb0: 68 20 24 61 72 67 73 5d 7d 20 7b 69 6e 63 72 20  h $args]} {incr 
3bc0: 69 64 78 20 32 7d 20 7b 0a 09 09 73 77 69 74 63  idx 2} {...switc
3bd0: 68 20 2d 67 6c 6f 62 20 2d 2d 20 5b 6c 69 6e 64  h -glob -- [lind
3be0: 65 78 20 24 61 72 67 73 20 24 69 64 78 5d 20 7b  ex $args $idx] {
3bf0: 0a 09 09 09 22 2d 67 6c 6f 62 22 20 7b 0a 09 09  ...."-glob" {...
3c00: 09 09 73 65 74 20 63 75 72 72 6d 61 74 63 68 6d  ..set currmatchm
3c10: 6f 64 65 20 22 67 6c 6f 62 22 0a 09 09 09 09 69  ode "glob".....i
3c20: 6e 63 72 20 69 64 78 20 2d 31 0a 09 09 09 09 63  ncr idx -1.....c
3c30: 6f 6e 74 69 6e 75 65 0a 09 09 09 7d 0a 09 09 09  ontinue....}....
3c40: 22 2d 2a 22 20 7b 0a 09 09 09 09 65 72 72 6f 72  "-*" {.....error
3c50: 20 22 55 6e 68 61 6e 64 6c 65 64 20 6f 70 74 69   "Unhandled opti
3c60: 6f 6e 3a 20 5b 6c 69 6e 64 65 78 20 24 61 72 67  on: [lindex $arg
3c70: 73 20 24 69 64 78 5d 22 0a 09 09 09 7d 0a 09 09  s $idx]"....}...
3c80: 7d 0a 0a 09 09 73 65 74 20 6b 20 5b 6c 69 6e 64  }....set k [lind
3c90: 65 78 20 24 61 72 67 73 20 24 69 64 78 5d 0a 09  ex $args $idx]..
3ca0: 09 73 65 74 20 76 20 5b 6c 69 6e 64 65 78 20 24  .set v [lindex $
3cb0: 61 72 67 73 20 5b 65 78 70 72 20 7b 24 69 64 78  args [expr {$idx
3cc0: 2b 31 7d 5d 5d 0a 0a 09 09 6c 61 70 70 65 6e 64  +1}]]....lappend
3cd0: 20 6b 65 79 73 20 24 6b 0a 09 09 6c 61 70 70 65   keys $k...lappe
3ce0: 6e 64 20 76 61 6c 75 65 73 20 24 76 0a 09 09 6c  nd values $v...l
3cf0: 61 70 70 65 6e 64 20 6d 61 74 63 68 6d 6f 64 65  append matchmode
3d00: 73 20 24 63 75 72 72 6d 61 74 63 68 6d 6f 64 65  s $currmatchmode
3d10: 0a 09 7d 0a 09 73 65 74 20 72 20 7b 7d 0a 09 6d  ..}..set r {}..m
3d20: 6b 5f 6c 6f 6f 70 20 63 20 24 70 61 74 68 20 7b  k_loop c $path {
3d30: 0a 09 09 73 65 74 20 78 20 5b 65 76 61 6c 20 6d  ...set x [eval m
3d40: 6b 5f 67 65 74 20 24 63 20 24 6b 65 79 73 5d 0a  k_get $c $keys].
3d50: 09 09 73 65 74 20 6d 61 74 63 68 43 6e 74 20 30  ..set matchCnt 0
3d60: 0a 09 09 66 6f 72 20 7b 73 65 74 20 69 64 78 20  ...for {set idx 
3d70: 30 7d 20 7b 24 69 64 78 20 3c 20 5b 6c 6c 65 6e  0} {$idx < [llen
3d80: 67 74 68 20 24 78 5d 7d 20 7b 69 6e 63 72 20 69  gth $x]} {incr i
3d90: 64 78 7d 20 7b 0a 09 09 09 73 65 74 20 76 61 6c  dx} {....set val
3da0: 20 5b 6c 69 6e 64 65 78 20 24 76 61 6c 75 65 73   [lindex $values
3db0: 20 24 69 64 78 5d 0a 09 09 09 73 65 74 20 63 68   $idx]....set ch
3dc0: 6b 76 61 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20  kval [lindex $x 
3dd0: 24 69 64 78 5d 0a 09 09 09 73 65 74 20 6d 61 74  $idx]....set mat
3de0: 63 68 6d 6f 64 65 20 5b 6c 69 6e 64 65 78 20 24  chmode [lindex $
3df0: 6d 61 74 63 68 6d 6f 64 65 73 20 24 69 64 78 5d  matchmodes $idx]
3e00: 0a 0a 09 09 09 73 77 69 74 63 68 20 2d 2d 20 24  .....switch -- $
3e10: 6d 61 74 63 68 6d 6f 64 65 20 7b 0a 09 09 09 09  matchmode {.....
3e20: 22 63 61 73 65 69 6e 73 65 6e 73 69 74 69 76 65  "caseinsensitive
3e30: 22 20 7b 0a 09 09 09 09 09 69 66 20 7b 24 76 61  " {......if {$va
3e40: 6c 20 3d 3d 20 24 63 68 6b 76 61 6c 7d 20 7b 0a  l == $chkval} {.
3e50: 09 09 09 09 09 09 69 6e 63 72 20 6d 61 74 63 68  ......incr match
3e60: 43 6e 74 0a 09 09 09 09 09 7d 0a 09 09 09 09 7d  Cnt......}.....}
3e70: 0a 09 09 09 09 22 67 6c 6f 62 22 20 7b 0a 09 09  ....."glob" {...
3e80: 09 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d  ...if {[string m
3e90: 61 74 63 68 20 24 76 61 6c 20 24 63 68 6b 76 61  atch $val $chkva
3ea0: 6c 5d 7d 20 7b 0a 09 09 09 09 09 09 69 6e 63 72  l]} {.......incr
3eb0: 20 6d 61 74 63 68 43 6e 74 0a 09 09 09 09 09 7d   matchCnt......}
3ec0: 0a 09 09 09 09 7d 0a 09 09 09 7d 0a 0a 09 09 7d  .....}....}....}
3ed0: 0a 09 09 69 66 20 7b 24 6d 61 74 63 68 43 6e 74  ...if {$matchCnt
3ee0: 20 3d 3d 20 5b 6c 6c 65 6e 67 74 68 20 24 6b 65   == [llength $ke
3ef0: 79 73 5d 7d 20 7b 0a 09 09 09 6c 61 70 70 65 6e  ys]} {....lappen
3f00: 64 20 72 20 5b 6d 6b 5f 63 75 72 73 6f 72 20 70  d r [mk_cursor p
3f10: 6f 73 69 74 69 6f 6e 20 63 5d 0a 09 09 7d 0a 09  osition c]...}..
3f20: 7d 0a 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65 78  }...if {[info ex
3f30: 69 73 74 73 20 6d 61 78 69 74 65 6d 73 5d 7d 20  ists maxitems]} 
3f40: 7b 0a 09 09 73 65 74 20 72 20 5b 6c 72 61 6e 67  {...set r [lrang
3f50: 65 20 24 72 20 30 20 5b 65 78 70 72 20 24 6d 61  e $r 0 [expr $ma
3f60: 78 69 74 65 6d 73 20 2d 20 31 5d 5d 0a 09 7d 0a  xitems - 1]]..}.
3f70: 0a 09 72 65 74 75 72 6e 20 24 72 0a 20 20 20 20  ..return $r.    
3f80: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6b 5f 5f  }..    proc mk__
3f90: 72 65 63 68 61 6e 20 7b 70 61 74 68 20 70 72 6f  rechan {path pro
3fa0: 70 20 63 6d 64 20 63 68 61 6e 20 61 72 67 73 7d  p cmd chan args}
3fb0: 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20 5b   {.#set indent [
3fc0: 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 22 20  string repeat " 
3fd0: 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65 6c     " [info level
3fe0: 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72 20  ]].#puts stderr 
3ff0: 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47 3a  "${indent}DEBUG:
4000: 20 72 65 61 64 6b 69 74 3a 3a 5f 72 65 63 68 61   readkit::_recha
4010: 6e 20 24 70 61 74 68 20 24 70 72 6f 70 20 24 63  n $path $prop $c
4020: 6d 64 20 24 63 68 61 6e 20 24 61 72 67 73 22 0a  md $chan $args".
4030: 0a 20 20 20 20 20 20 20 20 73 65 74 20 6b 65 79  .        set key
4040: 20 5b 6c 69 73 74 20 24 70 61 74 68 20 24 70 72   [list $path $pr
4050: 6f 70 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b  op].        if {
4060: 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 3a 3a  ![info exists ::
4070: 6d 6b 5f 5f 63 61 63 68 65 28 24 6b 65 79 29 5d  mk__cache($key)]
4080: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 73 65  } {.          se
4090: 74 20 3a 3a 6d 6b 5f 5f 63 61 63 68 65 28 24 6b  t ::mk__cache($k
40a0: 65 79 29 20 5b 72 65 61 64 6b 69 74 3a 3a 67 65  ey) [readkit::ge
40b0: 74 20 24 70 61 74 68 20 24 70 72 6f 70 5d 0a 20  t $path $prop]. 
40c0: 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20         }.       
40d0: 20 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73   if {![info exis
40e0: 74 73 20 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 74 28  ts ::mk__offset(
40f0: 24 6b 65 79 29 5d 7d 20 7b 0a 20 20 20 20 20 20  $key)]} {.      
4100: 20 20 20 20 73 65 74 20 3a 3a 6d 6b 5f 5f 6f 66      set ::mk__of
4110: 66 73 65 74 28 24 6b 65 79 29 20 30 0a 20 20 20  fset($key) 0.   
4120: 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 73       }.        s
4130: 65 74 20 64 61 74 61 20 24 3a 3a 6d 6b 5f 5f 63  et data $::mk__c
4140: 61 63 68 65 28 24 6b 65 79 29 0a 20 20 20 20 20  ache($key).     
4150: 20 20 20 73 65 74 20 6f 66 66 73 65 74 20 24 3a     set offset $:
4160: 3a 6d 6b 5f 5f 6f 66 66 73 65 74 28 24 6b 65 79  :mk__offset($key
4170: 29 0a 0a 20 20 20 20 20 20 20 20 73 77 69 74 63  )..        switc
4180: 68 20 2d 2d 20 24 63 6d 64 20 7b 0a 20 20 20 20  h -- $cmd {.    
4190: 20 20 20 20 20 20 20 20 22 72 65 61 64 22 20 7b          "read" {
41a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
41b0: 20 73 65 74 20 63 6f 75 6e 74 20 5b 6c 69 6e 64   set count [lind
41c0: 65 78 20 24 61 72 67 73 20 30 5d 0a 20 20 20 20  ex $args 0].    
41d0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20              set 
41e0: 72 65 74 76 61 6c 20 5b 73 74 72 69 6e 67 20 72  retval [string r
41f0: 61 6e 67 65 20 24 64 61 74 61 20 24 6f 66 66 73  ange $data $offs
4200: 65 74 20 5b 65 78 70 72 20 7b 24 6f 66 66 73 65  et [expr {$offse
4210: 74 20 2b 20 24 63 6f 75 6e 74 20 2d 20 31 7d 5d  t + $count - 1}]
4220: 5d 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  ]..             
4230: 20 20 20 73 65 74 20 72 65 61 64 62 79 74 65 73     set readbytes
4240: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20   [string length 
4250: 24 72 65 74 76 61 6c 5d 0a 0a 20 20 20 20 20 20  $retval]..      
4260: 20 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 6f            incr o
4270: 66 66 73 65 74 20 24 72 65 61 64 62 79 74 65 73  ffset $readbytes
4280: 0a 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20  .            }. 
4290: 20 20 20 20 20 20 20 20 20 20 20 22 63 6c 6f 73             "clos
42a0: 65 22 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20  e" {.           
42b0: 20 20 20 20 20 75 6e 73 65 74 20 2d 6e 6f 63 6f       unset -noco
42c0: 6d 70 6c 61 69 6e 20 3a 3a 6d 6b 5f 5f 63 61 63  mplain ::mk__cac
42d0: 68 65 28 24 6b 65 79 29 0a 20 20 20 20 20 20 20  he($key).       
42e0: 20 20 20 20 20 20 20 20 20 75 6e 73 65 74 20 2d           unset -
42f0: 6e 6f 63 6f 6d 70 6c 61 69 6e 20 3a 3a 6d 6b 5f  nocomplain ::mk_
4300: 5f 6f 66 66 73 65 74 28 24 6b 65 79 29 0a 20 20  _offset($key).  
4310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65                re
4320: 74 75 72 6e 0a 20 20 20 20 20 20 20 20 20 20 20  turn.           
4330: 20 7d 0a 20 20 20 20 20 20 20 20 20 20 20 20 64   }.            d
4340: 65 66 61 75 6c 74 20 7b 0a 23 70 75 74 73 20 73  efault {.#puts s
4350: 74 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d  tderr "${indent}
4360: 44 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a  DEBUG: readkit::
4370: 5f 72 65 63 68 61 6e 3a 20 43 61 6c 6c 65 64 20  _rechan: Called 
4380: 66 6f 72 20 63 6d 64 20 24 63 6d 64 22 0a 20 20  for cmd $cmd".  
4390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65                re
43a0: 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72  turn -code error
43b0: 20 22 4e 6f 74 20 69 6d 70 6c 65 6d 65 6e 74 65   "Not implemente
43c0: 64 3a 20 63 6d 64 20 3d 20 24 63 6d 64 22 0a 20  d: cmd = $cmd". 
43d0: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 20             }.   
43e0: 20 20 20 20 20 7d 0a 0a 20 20 20 20 20 20 20 20       }..        
43f0: 73 65 74 20 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 74  set ::mk__offset
4400: 28 24 6b 65 79 29 20 24 6f 66 66 73 65 74 0a 0a  ($key) $offset..
4410: 09 72 65 74 75 72 6e 20 24 72 65 74 76 61 6c 0a  .return $retval.
4420: 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20      }..    proc 
4430: 6d 6b 5f 63 68 61 6e 6e 65 6c 20 7b 70 61 74 68  mk_channel {path
4440: 20 70 72 6f 70 20 7b 6d 6f 64 65 20 22 72 22 7d   prop {mode "r"}
4450: 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20  } {.#set indent 
4460: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 22  [string repeat "
4470: 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65      " [info leve
4480: 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72  l]].#puts stderr
4490: 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47   "${indent}DEBUG
44a0: 3a 20 72 65 61 64 6b 69 74 3a 3a 63 68 61 6e 6e  : readkit::chann
44b0: 65 6c 20 24 70 61 74 68 20 24 70 72 6f 70 20 24  el $path $prop $
44c0: 6d 6f 64 65 22 0a 09 73 65 74 20 66 64 20 5b 72  mode"..set fd [r
44d0: 65 63 68 61 6e 20 5b 6c 69 73 74 20 6d 6b 5f 5f  echan [list mk__
44e0: 72 65 63 68 61 6e 20 24 70 61 74 68 20 24 70 72  rechan $path $pr
44f0: 6f 70 5d 20 32 5d 0a 0a 09 72 65 74 75 72 6e 20  op] 2]...return 
4500: 24 66 64 0a 20 20 20 20 7d 0a 20 20 20 20 23 20  $fd.    }.    # 
4510: 76 69 6d 3a 20 66 74 3d 74 63 6c 0a 0a 7d 0a 0a  vim: ft=tcl..}..
4520: 23 20 73 65 74 20 75 70 20 74 68 65 20 4d 65 74  # set up the Met
4530: 61 4b 69 74 20 63 6f 6d 70 61 74 69 62 69 6c 69  aKit compatibili
4540: 74 79 20 64 65 66 69 6e 69 74 69 6f 6e 73 0a 66  ty definitions.f
4550: 6f 72 65 61 63 68 20 78 20 7b 66 69 6c 65 20 76  oreach x {file v
4560: 69 65 77 20 63 75 72 73 6f 72 20 67 65 74 20 6c  iew cursor get l
4570: 6f 6f 70 20 73 65 6c 65 63 74 20 63 68 61 6e 6e  oop select chann
4580: 65 6c 7d 20 7b 0a 20 20 20 20 69 6e 74 65 72 70  el} {.    interp
4590: 20 61 6c 69 61 73 20 7b 7d 20 3a 3a 72 65 61 64   alias {} ::read
45a0: 6b 69 74 3a 3a 24 78 20 7b 7d 20 3a 3a 6d 6b 5f  kit::$x {} ::mk_
45b0: 24 78 0a 7d 0a 0a 0a 0a 23 20 6d 6b 34 76 66 73  $x.}....# mk4vfs
45c0: 2e 74 63 6c 20 2d 2d 20 4d 6b 34 74 63 6c 20 56  .tcl -- Mk4tcl V
45d0: 69 72 74 75 61 6c 20 46 69 6c 65 20 53 79 73 74  irtual File Syst
45e0: 65 6d 20 64 72 69 76 65 72 0a 23 20 43 6f 70 79  em driver.# Copy
45f0: 72 69 67 68 74 20 28 43 29 20 31 39 39 37 2d 32  right (C) 1997-2
4600: 30 30 33 20 53 65 6e 73 75 73 20 43 6f 6e 73 75  003 Sensus Consu
4610: 6c 74 69 6e 67 20 4c 74 64 2e 20 41 6c 6c 20 52  lting Ltd. All R
4620: 69 67 68 74 73 20 52 65 73 65 72 76 65 64 2e 0a  ights Reserved..
4630: 23 20 4d 61 74 74 20 4e 65 77 6d 61 6e 20 3c 6d  # Matt Newman <m
4640: 61 74 74 40 73 65 6e 73 75 73 2e 6f 72 67 3e 20  att@sensus.org> 
4650: 61 6e 64 20 4a 65 61 6e 2d 43 6c 61 75 64 65 20  and Jean-Claude 
4660: 57 69 70 70 6c 65 72 20 3c 6a 63 77 40 65 71 75  Wippler <jcw@equ
4670: 69 34 2e 63 6f 6d 3e 0a 23 0a 23 20 24 49 64 3a  i4.com>.#.# $Id:
4680: 20 6d 6b 34 76 66 73 2e 74 63 6c 2c 76 20 31 2e   mk4vfs.tcl,v 1.
4690: 34 31 20 32 30 30 38 2f 30 34 2f 31 35 20 32 31  41 2008/04/15 21
46a0: 3a 31 31 3a 35 33 20 61 6e 64 72 65 61 73 5f 6b  :11:53 andreas_k
46b0: 75 70 72 69 65 73 20 45 78 70 20 24 0a 23 0a 23  upries Exp $.#.#
46c0: 20 30 35 61 70 72 30 32 20 6a 63 77 09 31 2e 33   05apr02 jcw.1.3
46d0: 09 66 69 78 65 64 20 61 70 70 65 6e 64 20 6d 6f  .fixed append mo
46e0: 64 65 20 26 20 63 6c 6f 73 65 2c 0a 23 09 09 09  de & close,.#...
46f0: 70 72 69 76 61 74 69 7a 65 64 20 6d 65 6d 63 68  privatized memch
4700: 61 6e 5f 68 61 6e 64 6c 65 72 0a 23 09 09 09 61  an_handler.#...a
4710: 64 64 65 64 20 7a 69 70 2c 20 63 72 63 20 62 61  dded zip, crc ba
4720: 63 6b 20 69 6e 0a 23 20 32 38 61 70 72 30 32 20  ck in.# 28apr02 
4730: 6a 63 77 09 31 2e 34 09 72 65 6f 72 67 65 64 20  jcw.1.4.reorged 
4740: 6d 65 6d 63 68 61 6e 20 61 6e 64 20 70 6b 67 20  memchan and pkg 
4750: 64 65 70 65 6e 64 65 6e 63 69 65 73 0a 23 20 32  dependencies.# 2
4760: 32 6a 75 6e 30 32 20 6a 63 77 09 31 2e 35 09 66  2jun02 jcw.1.5.f
4770: 69 78 65 64 20 72 65 63 75 72 73 69 76 65 20 64  ixed recursive d
4780: 69 72 20 64 65 6c 65 74 69 6f 6e 0a 23 20 31 36  ir deletion.# 16
4790: 6f 63 74 30 32 20 6a 63 77 09 31 2e 36 09 66 69  oct02 jcw.1.6.fi
47a0: 78 65 64 20 70 65 72 69 6f 64 69 63 20 63 6f 6d  xed periodic com
47b0: 6d 69 74 20 6f 6e 63 65 20 61 20 63 68 61 6e 67  mit once a chang
47c0: 65 20 69 73 20 6d 61 64 65 0a 23 20 32 30 6a 61  e is made.# 20ja
47d0: 6e 30 33 20 6a 63 77 09 31 2e 37 09 73 74 72 65  n03 jcw.1.7.stre
47e0: 61 6d 65 64 20 7a 6c 69 62 20 64 65 63 6f 6d 70  amed zlib decomp
47f0: 72 65 73 73 20 6d 6f 64 65 2c 20 72 65 64 75 63  ress mode, reduc
4800: 65 73 20 6d 65 6d 6f 72 79 20 75 73 61 67 65 0a  es memory usage.
4810: 23 20 30 31 66 65 62 30 33 20 6a 63 77 09 31 2e  # 01feb03 jcw.1.
4820: 38 09 66 69 78 20 6d 6f 75 6e 74 69 6e 67 20 61  8.fix mounting a
4830: 20 73 79 6d 6c 69 6e 6b 2c 20 63 6c 65 61 6e 75   symlink, cleanu
4840: 70 20 6d 6f 75 6e 74 2f 75 6e 6d 6f 75 6e 74 20  p mount/unmount 
4850: 70 72 6f 63 73 0a 23 20 30 34 66 65 62 30 33 20  procs.# 04feb03 
4860: 6a 63 77 09 31 2e 38 09 77 68 6f 6f 70 73 2c 20  jcw.1.8.whoops, 
4870: 72 65 73 74 6f 72 65 64 20 76 66 73 3a 3a 6d 6b  restored vfs::mk
4880: 63 6c 3a 3a 55 6e 6d 6f 75 6e 74 20 6c 6f 67 69  cl::Unmount logi
4890: 63 0a 23 20 31 37 6d 61 72 30 33 20 6a 63 77 09  c.# 17mar03 jcw.
48a0: 31 2e 39 09 73 74 61 72 74 20 77 69 74 68 20 6d  1.9.start with m
48b0: 6f 64 65 20 74 72 61 6e 73 6c 75 63 65 6e 74 20  ode translucent 
48c0: 6f 72 20 72 65 61 64 77 72 69 74 65 0a 23 20 31  or readwrite.# 1
48d0: 38 6f 63 74 30 35 20 6a 63 77 09 31 2e 31 30 09  8oct05 jcw.1.10.
48e0: 61 64 64 20 66 61 6c 6c 62 61 63 6b 20 74 6f 20  add fallback to 
48f0: 4d 4b 20 43 6f 6d 70 61 74 69 62 6c 65 20 4c 69  MK Compatible Li
4900: 74 65 20 64 72 69 76 65 72 20 28 76 66 73 3a 3a  te driver (vfs::
4910: 6d 6b 63 6c 29 0a 0a 23 20 52 65 6d 6f 76 65 64  mkcl)..# Removed
4920: 20 70 72 6f 76 69 73 69 6f 6e 20 6f 66 20 74 68   provision of th
4930: 65 20 62 61 63 6b 77 61 72 64 20 63 6f 6d 70 61  e backward compa
4940: 74 69 62 6c 65 20 6e 61 6d 65 2e 20 4d 6f 76 65  tible name. Move
4950: 64 20 74 6f 20 73 65 70 61 72 61 74 65 0a 23 20  d to separate.# 
4960: 66 69 6c 65 2f 70 61 63 6b 61 67 65 2e 0a 63 61  file/package..ca
4970: 74 63 68 20 7b 0a 09 6c 6f 61 64 20 7b 7d 20 76  tch {..load {} v
4980: 66 73 0a 7d 0a 70 61 63 6b 61 67 65 20 72 65 71  fs.}.package req
4990: 75 69 72 65 20 76 66 73 0a 0a 23 20 74 68 69 6e  uire vfs..# thin
49a0: 67 73 20 74 68 61 74 20 63 61 6e 20 6e 6f 20 6c  gs that can no l
49b0: 6f 6e 67 65 72 20 72 65 61 6c 6c 79 20 62 65 20  onger really be 
49c0: 6c 65 66 74 20 6f 75 74 20 28 62 75 74 20 74 68  left out (but th
49d0: 69 73 20 69 73 20 74 68 65 20 77 72 6f 6e 67 20  is is the wrong 
49e0: 73 70 6f 74 21 29 0a 23 20 62 65 20 61 73 20 6e  spot!).# be as n
49f0: 6f 6e 2d 69 6e 76 61 73 69 76 65 20 61 73 20 70  on-invasive as p
4a00: 6f 73 73 69 62 6c 65 2c 20 75 73 69 6e 67 20 74  ossible, using t
4a10: 68 65 73 65 20 64 65 66 69 6e 69 74 69 6f 6e 73  hese definitions
4a20: 20 61 73 20 6c 61 73 74 20 72 65 73 6f 72 74 0a   as last resort.
4a30: 0a 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c 20  .namespace eval 
4a40: 76 66 73 3a 3a 6d 6b 63 6c 20 7b 0a 20 20 20 20  vfs::mkcl {.    
4a50: 70 72 6f 63 20 4d 6f 75 6e 74 20 7b 6d 6b 66 69  proc Mount {mkfi
4a60: 6c 65 20 6c 6f 63 61 6c 20 61 72 67 73 7d 20 7b  le local args} {
4a70: 0a 09 69 66 20 7b 24 6d 6b 66 69 6c 65 20 21 3d  ..if {$mkfile !=
4a80: 20 22 22 7d 20 7b 0a 09 20 20 23 20 64 65 72 65   ""} {..  # dere
4a90: 66 65 72 65 6e 63 65 20 61 20 73 79 6d 6c 69 6e  ference a symlin
4aa0: 6b 2c 20 6f 74 68 65 72 77 69 73 65 20 6d 6f 75  k, otherwise mou
4ab0: 6e 74 69 6e 67 20 6f 6e 20 69 74 20 66 61 69 6c  nting on it fail
4ac0: 73 20 28 77 68 79 3f 29 0a 09 20 20 63 61 74 63  s (why?)..  catc
4ad0: 68 20 7b 0a 09 20 20 20 20 73 65 74 20 6d 6b 66  h {..    set mkf
4ae0: 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b  ile [file join [
4af0: 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 24 6d 6b  file dirname $mk
4b00: 66 69 6c 65 5d 20 5c 0a 09 20 20 20 20 09 09 09  file] \..    ...
4b10: 20 20 5b 66 69 6c 65 20 72 65 61 64 6c 69 6e 6b    [file readlink
4b20: 20 24 6d 6b 66 69 6c 65 5d 5d 0a 09 20 20 7d 0a   $mkfile]]..  }.
4b30: 09 20 20 73 65 74 20 6d 6b 66 69 6c 65 20 5b 66  .  set mkfile [f
4b40: 69 6c 65 20 6e 6f 72 6d 61 6c 69 7a 65 20 24 6d  ile normalize $m
4b50: 6b 66 69 6c 65 5d 0a 09 7d 0a 09 73 65 74 20 64  kfile]..}..set d
4b60: 62 20 5b 65 76 61 6c 20 5b 6c 69 73 74 20 3a 3a  b [eval [list ::
4b70: 6d 6b 63 6c 5f 76 66 73 3a 3a 5f 6d 6f 75 6e 74  mkcl_vfs::_mount
4b80: 20 24 6d 6b 66 69 6c 65 5d 20 24 61 72 67 73 5d   $mkfile] $args]
4b90: 0a 09 3a 3a 76 66 73 3a 3a 66 69 6c 65 73 79 73  ..::vfs::filesys
4ba0: 74 65 6d 20 6d 6f 75 6e 74 20 24 6c 6f 63 61 6c  tem mount $local
4bb0: 20 5b 6c 69 73 74 20 3a 3a 76 66 73 3a 3a 6d 6b   [list ::vfs::mk
4bc0: 63 6c 3a 3a 68 61 6e 64 6c 65 72 20 24 64 62 5d  cl::handler $db]
4bd0: 0a 09 3a 3a 76 66 73 3a 3a 52 65 67 69 73 74 65  ..::vfs::Registe
4be0: 72 4d 6f 75 6e 74 20 24 6c 6f 63 61 6c 20 5b 6c  rMount $local [l
4bf0: 69 73 74 20 3a 3a 76 66 73 3a 3a 6d 6b 63 6c 3a  ist ::vfs::mkcl:
4c00: 3a 55 6e 6d 6f 75 6e 74 20 24 64 62 5d 0a 09 72  :Unmount $db]..r
4c10: 65 74 75 72 6e 20 24 64 62 0a 20 20 20 20 7d 0a  eturn $db.    }.
4c20: 0a 20 20 20 20 70 72 6f 63 20 55 6e 6d 6f 75 6e  .    proc Unmoun
4c30: 74 20 7b 64 62 20 6c 6f 63 61 6c 7d 20 7b 0a 09  t {db local} {..
4c40: 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20  vfs::filesystem 
4c50: 75 6e 6d 6f 75 6e 74 20 24 6c 6f 63 61 6c 0a 09  unmount $local..
4c60: 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 5f 75 6d 6f  ::mkcl_vfs::_umo
4c70: 75 6e 74 20 24 64 62 0a 20 20 20 20 7d 0a 0a 20  unt $db.    }.. 
4c80: 20 20 20 70 72 6f 63 20 61 74 74 72 69 62 75 74     proc attribut
4c90: 65 73 20 7b 64 62 7d 20 7b 20 72 65 74 75 72 6e  es {db} { return
4ca0: 20 5b 6c 69 73 74 20 22 73 74 61 74 65 22 20 22   [list "state" "
4cb0: 63 6f 6d 6d 69 74 22 5d 20 7d 0a 20 20 20 20 0a  commit"] }.    .
4cc0: 20 20 20 20 23 20 43 61 6e 20 75 73 65 20 74 68      # Can use th
4cd0: 69 73 20 74 6f 20 63 6f 6e 74 72 6f 6c 20 63 6f  is to control co
4ce0: 6d 6d 69 74 2f 6e 6f 63 6f 6d 6d 69 74 20 6f 72  mmit/nocommit or
4cf0: 20 77 68 61 74 65 76 65 72 2e 0a 20 20 20 20 23   whatever..    #
4d00: 20 49 27 6d 20 6e 6f 74 20 73 75 72 65 20 79 65   I'm not sure ye
4d10: 74 20 6f 66 20 77 68 61 74 20 66 75 6e 63 74 69  t of what functi
4d20: 6f 6e 61 6c 69 74 79 20 6a 63 77 20 6e 65 65 64  onality jcw need
4d30: 73 2e 0a 20 20 20 20 70 72 6f 63 20 63 6f 6d 6d  s..    proc comm
4d40: 69 74 20 7b 64 62 20 61 72 67 73 7d 20 7b 0a 09  it {db args} {..
4d50: 73 77 69 74 63 68 20 2d 2d 20 5b 6c 6c 65 6e 67  switch -- [lleng
4d60: 74 68 20 24 61 72 67 73 5d 20 7b 0a 09 20 20 20  th $args] {..   
4d70: 20 30 20 7b 0a 09 09 69 66 20 7b 24 3a 3a 6d 6b   0 {...if {$::mk
4d80: 63 6c 5f 76 66 73 3a 3a 76 3a 3a 6d 6f 64 65 28  cl_vfs::v::mode(
4d90: 24 64 62 29 20 3d 3d 20 22 72 65 61 64 6f 6e 6c  $db) == "readonl
4da0: 79 22 7d 20 7b 0a 09 09 20 20 20 20 72 65 74 75  y"} {...    retu
4db0: 72 6e 20 30 0a 09 09 7d 20 65 6c 73 65 20 7b 0a  rn 0...} else {.
4dc0: 09 09 20 20 20 20 23 20 54 6f 20 44 6f 3a 20 72  ..    # To Do: r
4dd0: 65 61 64 20 74 68 65 20 63 6f 6d 6d 69 74 20 73  ead the commit s
4de0: 74 61 74 65 0a 09 09 20 20 20 20 72 65 74 75 72  tate...    retur
4df0: 6e 20 31 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09  n 1...}..    }..
4e00: 20 20 20 20 31 20 7b 0a 09 09 73 65 74 20 76 61      1 {...set va
4e10: 6c 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20  l [lindex $args 
4e20: 30 5d 0a 09 09 69 66 20 7b 24 76 61 6c 20 21 3d  0]...if {$val !=
4e30: 20 30 20 26 26 20 24 76 61 6c 20 21 3d 20 31 7d   0 && $val != 1}
4e40: 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20   {...    return 
4e50: 2d 63 6f 64 65 20 65 72 72 6f 72 20 5c 0a 09 09  -code error \...
4e60: 20 20 20 20 20 20 22 69 6e 76 61 6c 69 64 20 63        "invalid c
4e70: 6f 6d 6d 69 74 20 76 61 6c 75 65 20 24 76 61 6c  ommit value $val
4e80: 2c 20 6d 75 73 74 20 62 65 20 30 2c 31 22 0a 09  , must be 0,1"..
4e90: 09 7d 0a 09 09 23 20 54 6f 20 44 6f 3a 20 73 65  .}...# To Do: se
4ea0: 74 20 74 68 65 20 63 6f 6d 6d 69 74 20 73 74 61  t the commit sta
4eb0: 74 65 2e 0a 09 20 20 20 20 7d 0a 09 20 20 20 20  te...    }..    
4ec0: 64 65 66 61 75 6c 74 20 7b 0a 09 09 72 65 74 75  default {...retu
4ed0: 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 22  rn -code error "
4ee0: 57 72 6f 6e 67 20 6e 75 6d 20 61 72 67 73 22 0a  Wrong num args".
4ef0: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a  .    }..}.    }.
4f00: 20 20 20 20 0a 20 20 20 20 70 72 6f 63 20 73 74      .    proc st
4f10: 61 74 65 20 7b 64 62 20 61 72 67 73 7d 20 7b 0a  ate {db args} {.
4f20: 09 73 77 69 74 63 68 20 2d 2d 20 5b 6c 6c 65 6e  .switch -- [llen
4f30: 67 74 68 20 24 61 72 67 73 5d 20 7b 0a 09 20 20  gth $args] {..  
4f40: 20 20 30 20 7b 0a 09 09 72 65 74 75 72 6e 20 24    0 {...return $
4f50: 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a 6d  ::mkcl_vfs::v::m
4f60: 6f 64 65 28 24 64 62 29 0a 09 20 20 20 20 7d 0a  ode($db)..    }.
4f70: 09 20 20 20 20 31 20 7b 0a 09 09 73 65 74 20 76  .    1 {...set v
4f80: 61 6c 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73  al [lindex $args
4f90: 20 30 5d 0a 09 09 69 66 20 7b 5b 6c 73 65 61 72   0]...if {[lsear
4fa0: 63 68 20 2d 65 78 61 63 74 20 5b 3a 3a 76 66 73  ch -exact [::vfs
4fb0: 3a 3a 73 74 61 74 65 73 5d 20 24 76 61 6c 5d 20  ::states] $val] 
4fc0: 3d 3d 20 2d 31 7d 20 7b 0a 09 09 20 20 20 20 72  == -1} {...    r
4fd0: 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f  eturn -code erro
4fe0: 72 20 5c 0a 09 09 20 20 20 20 20 20 22 69 6e 76  r \...      "inv
4ff0: 61 6c 69 64 20 73 74 61 74 65 20 24 76 61 6c 2c  alid state $val,
5000: 20 6d 75 73 74 20 62 65 20 6f 6e 65 20 6f 66 3a   must be one of:
5010: 20 5b 76 66 73 3a 3a 73 74 61 74 65 73 5d 22 0a   [vfs::states]".
5020: 09 09 7d 0a 09 09 73 65 74 20 3a 3a 6d 6b 63 6c  ..}...set ::mkcl
5030: 5f 76 66 73 3a 3a 76 3a 3a 6d 6f 64 65 28 24 64  _vfs::v::mode($d
5040: 62 29 20 24 76 61 6c 0a 09 09 3a 3a 6d 6b 63 6c  b) $val...::mkcl
5050: 5f 76 66 73 3a 3a 73 65 74 75 70 43 6f 6d 6d 69  _vfs::setupCommi
5060: 74 73 20 24 64 62 0a 09 20 20 20 20 7d 0a 09 20  ts $db..    }.. 
5070: 20 20 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 72     default {...r
5080: 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f  eturn -code erro
5090: 72 20 22 57 72 6f 6e 67 20 6e 75 6d 20 61 72 67  r "Wrong num arg
50a0: 73 22 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20  s"..    }..}.   
50b0: 20 7d 0a 20 20 20 20 0a 20 20 20 20 70 72 6f 63   }.    .    proc
50c0: 20 68 61 6e 64 6c 65 72 20 7b 64 62 20 63 6d 64   handler {db cmd
50d0: 20 72 6f 6f 74 20 72 65 6c 61 74 69 76 65 20 61   root relative a
50e0: 63 74 75 61 6c 70 61 74 68 20 61 72 67 73 7d 20  ctualpath args} 
50f0: 7b 0a 09 23 70 75 74 73 20 73 74 64 65 72 72 20  {..#puts stderr 
5100: 22 68 61 6e 64 6c 65 72 3a 20 24 64 62 20 2d 20  "handler: $db - 
5110: 24 63 6d 64 20 2d 20 24 72 6f 6f 74 20 2d 20 24  $cmd - $root - $
5120: 72 65 6c 61 74 69 76 65 20 2d 20 24 61 63 74 75  relative - $actu
5130: 61 6c 70 61 74 68 20 2d 20 24 61 72 67 73 22 0a  alpath - $args".
5140: 09 69 66 20 7b 24 63 6d 64 20 3d 3d 20 22 6d 61  .if {$cmd == "ma
5150: 74 63 68 69 6e 64 69 72 65 63 74 6f 72 79 22 7d  tchindirectory"}
5160: 20 7b 0a 09 20 20 20 20 65 76 61 6c 20 5b 6c 69   {..    eval [li
5170: 73 74 20 24 63 6d 64 20 24 64 62 20 24 72 65 6c  st $cmd $db $rel
5180: 61 74 69 76 65 20 24 61 63 74 75 61 6c 70 61 74  ative $actualpat
5190: 68 5d 20 24 61 72 67 73 0a 09 7d 20 65 6c 73 65  h] $args..} else
51a0: 69 66 20 7b 24 63 6d 64 20 3d 3d 20 22 66 69 6c  if {$cmd == "fil
51b0: 65 61 74 74 72 69 62 75 74 65 73 22 7d 20 7b 0a  eattributes"} {.
51c0: 09 20 20 20 20 65 76 61 6c 20 5b 6c 69 73 74 20  .    eval [list 
51d0: 24 63 6d 64 20 24 64 62 20 24 72 6f 6f 74 20 24  $cmd $db $root $
51e0: 72 65 6c 61 74 69 76 65 5d 20 24 61 72 67 73 0a  relative] $args.
51f0: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 65  .} else {..    e
5200: 76 61 6c 20 5b 6c 69 73 74 20 24 63 6d 64 20 24  val [list $cmd $
5210: 64 62 20 24 72 65 6c 61 74 69 76 65 5d 20 24 61  db $relative] $a
5220: 72 67 73 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20  rgs..}.    }..  
5230: 20 20 70 72 6f 63 20 75 74 69 6d 65 20 7b 64 62    proc utime {db
5240: 20 70 61 74 68 20 61 63 74 69 6d 65 20 6d 6f 64   path actime mod
5250: 74 69 6d 65 7d 20 7b 0a 09 3a 3a 6d 6b 63 6c 5f  time} {..::mkcl_
5260: 76 66 73 3a 3a 73 74 61 74 20 24 64 62 20 24 70  vfs::stat $db $p
5270: 61 74 68 20 73 62 0a 09 0a 09 69 66 20 7b 20 24  ath sb....if { $
5280: 73 62 28 74 79 70 65 29 20 3d 3d 20 22 66 69 6c  sb(type) == "fil
5290: 65 22 20 7d 20 7b 0a 09 20 20 20 20 72 65 61 64  e" } {..    read
52a0: 6b 69 74 3a 3a 73 65 74 20 24 73 62 28 69 6e 6f  kit::set $sb(ino
52b0: 29 20 64 61 74 65 20 24 6d 6f 64 74 69 6d 65 0a  ) date $modtime.
52c0: 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72  .}.    }..    pr
52d0: 6f 63 20 6d 61 74 63 68 69 6e 64 69 72 65 63 74  oc matchindirect
52e0: 6f 72 79 20 7b 64 62 20 70 61 74 68 20 61 63 74  ory {db path act
52f0: 75 61 6c 70 61 74 68 20 70 61 74 74 65 72 6e 20  ualpath pattern 
5300: 74 79 70 65 7d 20 7b 0a 09 73 65 74 20 6e 65 77  type} {..set new
5310: 72 65 73 20 5b 6c 69 73 74 5d 0a 09 69 66 20 7b  res [list]..if {
5320: 21 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20  ![string length 
5330: 24 70 61 74 74 65 72 6e 5d 7d 20 7b 0a 09 20 20  $pattern]} {..  
5340: 20 20 23 20 63 68 65 63 6b 20 73 69 6e 67 6c 65    # check single
5350: 20 66 69 6c 65 0a 09 20 20 20 20 69 66 20 7b 5b   file..    if {[
5360: 63 61 74 63 68 20 7b 61 63 63 65 73 73 20 24 64  catch {access $d
5370: 62 20 24 70 61 74 68 20 30 7d 5d 7d 20 7b 0a 09  b $path 0}]} {..
5380: 09 72 65 74 75 72 6e 20 7b 7d 0a 09 20 20 20 20  .return {}..    
5390: 7d 0a 09 20 20 20 20 73 65 74 20 72 65 73 20 5b  }..    set res [
53a0: 6c 69 73 74 20 24 61 63 74 75 61 6c 70 61 74 68  list $actualpath
53b0: 5d 0a 09 20 20 20 20 73 65 74 20 61 63 74 75 61  ]..    set actua
53c0: 6c 70 61 74 68 20 22 22 0a 09 7d 20 65 6c 73 65  lpath ""..} else
53d0: 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 73 20   {..    set res 
53e0: 5b 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 67 65 74  [::mkcl_vfs::get
53f0: 64 69 72 20 24 64 62 20 24 70 61 74 68 20 24 70  dir $db $path $p
5400: 61 74 74 65 72 6e 5d 0a 09 7d 0a 09 66 6f 72 65  attern]..}..fore
5410: 61 63 68 20 70 20 5b 3a 3a 76 66 73 3a 3a 6d 61  ach p [::vfs::ma
5420: 74 63 68 43 6f 72 72 65 63 74 54 79 70 65 73 20  tchCorrectTypes 
5430: 24 74 79 70 65 20 24 72 65 73 20 24 61 63 74 75  $type $res $actu
5440: 61 6c 70 61 74 68 5d 20 7b 0a 09 20 20 20 20 6c  alpath] {..    l
5450: 61 70 70 65 6e 64 20 6e 65 77 72 65 73 20 5b 66  append newres [f
5460: 69 6c 65 20 6a 6f 69 6e 20 24 61 63 74 75 61 6c  ile join $actual
5470: 70 61 74 68 20 24 70 5d 0a 09 7d 0a 09 72 65 74  path $p]..}..ret
5480: 75 72 6e 20 24 6e 65 77 72 65 73 0a 20 20 20 20  urn $newres.    
5490: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 73 74 61 74  }..    proc stat
54a0: 20 7b 64 62 20 6e 61 6d 65 7d 20 7b 0a 09 3a 3a   {db name} {..::
54b0: 6d 6b 63 6c 5f 76 66 73 3a 3a 73 74 61 74 20 24  mkcl_vfs::stat $
54c0: 64 62 20 24 6e 61 6d 65 20 73 62 0a 0a 09 73 65  db $name sb...se
54d0: 74 20 73 62 28 69 6e 6f 29 20 30 0a 09 61 72 72  t sb(ino) 0..arr
54e0: 61 79 20 67 65 74 20 73 62 0a 20 20 20 20 7d 0a  ay get sb.    }.
54f0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 73 73  .    proc access
5500: 20 7b 64 62 20 6e 61 6d 65 20 6d 6f 64 65 7d 20   {db name mode} 
5510: 7b 0a 09 69 66 20 7b 24 6d 6f 64 65 20 26 20 32  {..if {$mode & 2
5520: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 3a 3a  } {..    if {$::
5530: 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a 6d 6f 64  mkcl_vfs::v::mod
5540: 65 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 6f  e($db) == "reado
5550: 6e 6c 79 22 7d 20 7b 0a 09 09 76 66 73 3a 3a 66  nly"} {...vfs::f
5560: 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 65  ilesystem posixe
5570: 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f 73  rror $::vfs::pos
5580: 69 78 28 45 52 4f 46 53 29 0a 09 20 20 20 20 7d  ix(EROFS)..    }
5590: 0a 09 7d 0a 09 23 20 57 65 20 63 61 6e 20 70 72  ..}..# We can pr
55a0: 6f 62 61 62 6c 79 20 64 6f 20 74 68 69 73 20 6d  obably do this m
55b0: 6f 72 65 20 65 66 66 69 63 69 65 6e 74 6c 79 2c  ore efficiently,
55c0: 20 63 61 6e 27 74 20 77 65 3f 0a 09 3a 3a 6d 6b   can't we?..::mk
55d0: 63 6c 5f 76 66 73 3a 3a 73 74 61 74 20 24 64 62  cl_vfs::stat $db
55e0: 20 24 6e 61 6d 65 20 73 62 0a 20 20 20 20 7d 0a   $name sb.    }.
55f0: 0a 20 20 20 20 70 72 6f 63 20 6f 70 65 6e 20 7b  .    proc open {
5600: 64 62 20 66 69 6c 65 20 6d 6f 64 65 20 70 65 72  db file mode per
5610: 6d 69 73 73 69 6f 6e 73 7d 20 7b 0a 09 23 20 72  missions} {..# r
5620: 65 74 75 72 6e 20 61 20 6c 69 73 74 20 6f 66 20  eturn a list of 
5630: 74 77 6f 20 65 6c 65 6d 65 6e 74 73 3a 0a 09 23  two elements:..#
5640: 20 31 2e 20 66 69 72 73 74 20 65 6c 65 6d 65 6e   1. first elemen
5650: 74 20 69 73 20 74 68 65 20 54 63 6c 20 63 68 61  t is the Tcl cha
5660: 6e 6e 65 6c 20 6e 61 6d 65 20 77 68 69 63 68 20  nnel name which 
5670: 68 61 73 20 62 65 65 6e 20 6f 70 65 6e 65 64 0a  has been opened.
5680: 09 23 20 32 2e 20 73 65 63 6f 6e 64 20 65 6c 65  .# 2. second ele
5690: 6d 65 6e 74 20 28 6f 70 74 69 6f 6e 61 6c 29 20  ment (optional) 
56a0: 69 73 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20  is a command to 
56b0: 65 76 61 6c 75 61 74 65 20 77 68 65 6e 0a 09 23  evaluate when..#
56c0: 20 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 69 73    the channel is
56d0: 20 63 6c 6f 73 65 64 2e 0a 09 73 77 69 74 63 68   closed...switch
56e0: 20 2d 67 6c 6f 62 20 2d 2d 20 24 6d 6f 64 65 20   -glob -- $mode 
56f0: 7b 0a 09 20 20 20 20 7b 7d 20 20 2d 0a 09 20 20  {..    {}  -..  
5700: 20 20 72 20 7b 0a 09 09 3a 3a 6d 6b 63 6c 5f 76    r {...::mkcl_v
5710: 66 73 3a 3a 73 74 61 74 20 24 64 62 20 24 66 69  fs::stat $db $fi
5720: 6c 65 20 73 62 0a 0a 09 09 69 66 20 7b 20 24 73  le sb....if { $s
5730: 62 28 63 73 69 7a 65 29 20 21 3d 20 24 73 62 28  b(csize) != $sb(
5740: 73 69 7a 65 29 20 7d 20 7b 0a 09 09 20 20 20 20  size) } {...    
5750: 69 66 20 7b 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a  if {$::mkcl_vfs:
5760: 3a 7a 73 74 72 65 61 6d 65 64 7d 20 7b 0a 09 09  :zstreamed} {...
5770: 20 20 20 20 20 20 73 65 74 20 66 64 20 5b 72 65        set fd [re
5780: 61 64 6b 69 74 3a 3a 63 68 61 6e 6e 65 6c 20 24  adkit::channel $
5790: 73 62 28 69 6e 6f 29 20 63 6f 6e 74 65 6e 74 73  sb(ino) contents
57a0: 20 72 5d 0a 09 09 20 20 20 20 20 20 66 63 6f 6e   r]...      fcon
57b0: 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 6e  figure $fd -tran
57c0: 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a 09  slation binary..
57d0: 09 20 20 20 20 20 20 73 65 74 20 66 64 20 5b 76  .      set fd [v
57e0: 66 73 3a 3a 7a 73 74 72 65 61 6d 20 64 65 63 6f  fs::zstream deco
57f0: 6d 70 72 65 73 73 20 24 66 64 20 24 73 62 28 63  mpress $fd $sb(c
5800: 73 69 7a 65 29 20 24 73 62 28 73 69 7a 65 29 5d  size) $sb(size)]
5810: 0a 09 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a  ...    } else {.
5820: 09 09 20 20 20 20 20 20 73 65 74 20 66 64 20 5b  ..      set fd [
5830: 76 66 73 3a 3a 6d 65 6d 63 68 61 6e 5d 0a 09 09  vfs::memchan]...
5840: 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65        fconfigure
5850: 20 24 66 64 20 2d 74 72 61 6e 73 6c 61 74 69 6f   $fd -translatio
5860: 6e 20 62 69 6e 61 72 79 0a 09 09 20 20 20 20 20  n binary...     
5870: 20 73 65 74 20 73 20 5b 72 65 61 64 6b 69 74 3a   set s [readkit:
5880: 3a 67 65 74 20 24 73 62 28 69 6e 6f 29 20 63 6f  :get $sb(ino) co
5890: 6e 74 65 6e 74 73 5d 0a 09 09 20 20 20 20 20 20  ntents]...      
58a0: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20  puts -nonewline 
58b0: 24 66 64 20 5b 76 66 73 3a 3a 7a 69 70 20 2d 6d  $fd [vfs::zip -m
58c0: 6f 64 65 20 64 65 63 6f 6d 70 72 65 73 73 20 24  ode decompress $
58d0: 73 5d 0a 0a 09 09 20 20 20 20 20 20 66 63 6f 6e  s]....      fcon
58e0: 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 6e  figure $fd -tran
58f0: 73 6c 61 74 69 6f 6e 20 61 75 74 6f 0a 09 09 20  slation auto... 
5900: 20 20 20 20 20 73 65 65 6b 20 24 66 64 20 30 0a       seek $fd 0.
5910: 09 09 20 20 20 20 7d 0a 09 09 7d 20 65 6c 73 65  ..    }...} else
5920: 69 66 20 7b 20 24 3a 3a 6d 6b 63 6c 5f 76 66 73  if { $::mkcl_vfs
5930: 3a 3a 64 69 72 65 63 74 20 7d 20 7b 0a 09 09 20  ::direct } {... 
5940: 20 20 20 73 65 74 20 66 64 20 5b 76 66 73 3a 3a     set fd [vfs::
5950: 6d 65 6d 63 68 61 6e 5d 0a 09 09 20 20 20 20 66  memchan]...    f
5960: 63 6f 6e 66 69 67 75 72 65 20 24 66 64 20 2d 74  configure $fd -t
5970: 72 61 6e 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72  ranslation binar
5980: 79 0a 09 09 20 20 20 20 70 75 74 73 20 2d 6e 6f  y...    puts -no
5990: 6e 65 77 6c 69 6e 65 20 24 66 64 20 5b 72 65 61  newline $fd [rea
59a0: 64 6b 69 74 3a 3a 67 65 74 20 24 73 62 28 69 6e  dkit::get $sb(in
59b0: 6f 29 20 63 6f 6e 74 65 6e 74 73 5d 0a 0a 09 09  o) contents]....
59c0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24      fconfigure $
59d0: 66 64 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20  fd -translation 
59e0: 61 75 74 6f 0a 09 09 20 20 20 20 73 65 65 6b 20  auto...    seek 
59f0: 24 66 64 20 30 0a 09 09 7d 20 65 6c 73 65 20 7b  $fd 0...} else {
5a00: 0a 09 09 20 20 20 20 73 65 74 20 66 64 20 5b 72  ...    set fd [r
5a10: 65 61 64 6b 69 74 3a 3a 63 68 61 6e 6e 65 6c 20  eadkit::channel 
5a20: 24 73 62 28 69 6e 6f 29 20 63 6f 6e 74 65 6e 74  $sb(ino) content
5a30: 73 20 72 5d 0a 09 09 7d 0a 09 09 72 65 74 75 72  s r]...}...retur
5a40: 6e 20 5b 6c 69 73 74 20 24 66 64 5d 0a 09 20 20  n [list $fd]..  
5a50: 20 20 7d 0a 09 20 20 20 20 61 20 7b 0a 09 09 69    }..    a {...i
5a60: 66 20 7b 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a  f {$::mkcl_vfs::
5a70: 76 3a 3a 6d 6f 64 65 28 24 64 62 29 20 3d 3d 20  v::mode($db) == 
5a80: 22 72 65 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 09  "readonly"} {...
5a90: 20 20 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 73      vfs::filesys
5aa0: 74 65 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 24  tem posixerror $
5ab0: 3a 3a 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f  ::vfs::posix(ERO
5ac0: 46 53 29 0a 09 09 7d 0a 09 09 69 66 20 7b 20 5b  FS)...}...if { [
5ad0: 63 61 74 63 68 20 7b 3a 3a 6d 6b 63 6c 5f 76 66  catch {::mkcl_vf
5ae0: 73 3a 3a 73 74 61 74 20 24 64 62 20 24 66 69 6c  s::stat $db $fil
5af0: 65 20 73 62 20 7d 5d 20 7d 20 7b 0a 09 09 20 20  e sb }] } {...  
5b00: 20 20 23 20 43 72 65 61 74 65 20 66 69 6c 65 0a    # Create file.
5b10: 09 09 20 20 20 20 3a 3a 6d 6b 63 6c 5f 76 66 73  ..    ::mkcl_vfs
5b20: 3a 3a 73 74 61 74 20 24 64 62 20 5b 66 69 6c 65  ::stat $db [file
5b30: 20 64 69 72 6e 61 6d 65 20 24 66 69 6c 65 5d 20   dirname $file] 
5b40: 73 62 0a 09 09 20 20 20 20 73 65 74 20 74 61 69  sb...    set tai
5b50: 6c 20 5b 66 69 6c 65 20 74 61 69 6c 20 24 66 69  l [file tail $fi
5b60: 6c 65 5d 0a 09 09 20 20 20 20 73 65 74 20 66 76  le]...    set fv
5b70: 69 65 77 20 24 73 62 28 69 6e 6f 29 2e 66 69 6c  iew $sb(ino).fil
5b80: 65 73 0a 09 09 20 20 20 20 69 66 20 7b 5b 69 6e  es...    if {[in
5b90: 66 6f 20 65 78 69 73 74 73 20 6d 6b 63 6c 5f 76  fo exists mkcl_v
5ba0: 66 73 3a 3a 76 3a 3a 66 63 61 63 68 65 28 24 66  fs::v::fcache($f
5bb0: 76 69 65 77 29 5d 7d 20 7b 0a 09 09 09 6c 61 70  view)]} {....lap
5bc0: 70 65 6e 64 20 6d 6b 63 6c 5f 76 66 73 3a 3a 76  pend mkcl_vfs::v
5bd0: 3a 3a 66 63 61 63 68 65 28 24 66 76 69 65 77 29  ::fcache($fview)
5be0: 20 24 74 61 69 6c 0a 09 09 20 20 20 20 7d 0a 09   $tail...    }..
5bf0: 09 20 20 20 20 73 65 74 20 6e 6f 77 20 5b 63 6c  .    set now [cl
5c00: 6f 63 6b 20 73 65 63 6f 6e 64 73 5d 0a 09 09 20  ock seconds]... 
5c10: 20 20 20 73 65 74 20 73 62 28 69 6e 6f 29 20 5b     set sb(ino) [
5c20: 72 65 61 64 6b 69 74 3a 3a 72 6f 77 20 61 70 70  readkit::row app
5c30: 65 6e 64 20 24 66 76 69 65 77 20 5c 0a 09 09 09  end $fview \....
5c40: 20 20 20 20 6e 61 6d 65 20 24 74 61 69 6c 20 73      name $tail s
5c50: 69 7a 65 20 30 20 64 61 74 65 20 24 6e 6f 77 20  ize 0 date $now 
5c60: 5d 0a 0a 09 09 20 20 20 20 69 66 20 7b 20 5b 73  ]....    if { [s
5c70: 74 72 69 6e 67 20 6d 61 74 63 68 20 2a 7a 2a 20  tring match *z* 
5c80: 24 6d 6f 64 65 5d 20 7c 7c 20 24 6d 6b 63 6c 5f  $mode] || $mkcl_
5c90: 76 66 73 3a 3a 63 6f 6d 70 72 65 73 73 20 7d 20  vfs::compress } 
5ca0: 7b 0a 09 09 09 73 65 74 20 73 62 28 63 73 69 7a  {....set sb(csiz
5cb0: 65 29 20 2d 31 20 20 3b 23 20 48 41 43 4b 20 2d  e) -1  ;# HACK -
5cc0: 20 66 6f 72 63 65 20 63 6f 6d 70 72 65 73 73 69   force compressi
5cd0: 6f 6e 0a 09 09 20 20 20 20 7d 20 65 6c 73 65 20  on...    } else 
5ce0: 7b 0a 09 09 09 73 65 74 20 73 62 28 63 73 69 7a  {....set sb(csiz
5cf0: 65 29 20 30 0a 09 09 20 20 20 20 7d 0a 09 09 7d  e) 0...    }...}
5d00: 0a 0a 09 09 73 65 74 20 66 64 20 5b 76 66 73 3a  ....set fd [vfs:
5d10: 3a 6d 65 6d 63 68 61 6e 5d 0a 09 09 66 63 6f 6e  :memchan]...fcon
5d20: 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 6e  figure $fd -tran
5d30: 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a 09  slation binary..
5d40: 09 73 65 74 20 73 20 5b 72 65 61 64 6b 69 74 3a  .set s [readkit:
5d50: 3a 67 65 74 20 24 73 62 28 69 6e 6f 29 20 63 6f  :get $sb(ino) co
5d60: 6e 74 65 6e 74 73 5d 0a 0a 09 09 69 66 20 7b 20  ntents]....if { 
5d70: 24 73 62 28 63 73 69 7a 65 29 20 21 3d 20 24 73  $sb(csize) != $s
5d80: 62 28 73 69 7a 65 29 20 26 26 20 24 73 62 28 63  b(size) && $sb(c
5d90: 73 69 7a 65 29 20 3e 20 30 20 7d 20 7b 0a 09 09  size) > 0 } {...
5da0: 20 20 20 20 61 70 70 65 6e 64 20 6d 6f 64 65 20      append mode 
5db0: 7a 0a 09 09 20 20 20 20 70 75 74 73 20 2d 6e 6f  z...    puts -no
5dc0: 6e 65 77 6c 69 6e 65 20 24 66 64 20 5b 76 66 73  newline $fd [vfs
5dd0: 3a 3a 7a 69 70 20 2d 6d 6f 64 65 20 64 65 63 6f  ::zip -mode deco
5de0: 6d 70 72 65 73 73 20 24 73 5d 0a 09 09 7d 20 65  mpress $s]...} e
5df0: 6c 73 65 20 7b 0a 09 09 20 20 20 20 69 66 20 7b  lse {...    if {
5e00: 20 24 6d 6b 63 6c 5f 76 66 73 3a 3a 63 6f 6d 70   $mkcl_vfs::comp
5e10: 72 65 73 73 20 7d 20 7b 20 61 70 70 65 6e 64 20  ress } { append 
5e20: 6d 6f 64 65 20 7a 20 7d 0a 09 09 20 20 20 20 70  mode z }...    p
5e30: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24  uts -nonewline $
5e40: 66 64 20 24 73 0a 09 09 20 20 20 20 23 73 65 74  fd $s...    #set
5e50: 20 66 64 20 5b 72 65 61 64 6b 69 74 3a 3a 63 68   fd [readkit::ch
5e60: 61 6e 6e 65 6c 20 24 73 62 28 69 6e 6f 29 20 63  annel $sb(ino) c
5e70: 6f 6e 74 65 6e 74 73 20 61 5d 0a 09 09 7d 0a 09  ontents a]...}..
5e80: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 66 64 20  .fconfigure $fd 
5e90: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 61 75 74  -translation aut
5ea0: 6f 0a 09 09 73 65 65 6b 20 24 66 64 20 30 20 65  o...seek $fd 0 e
5eb0: 6e 64 0a 09 09 72 65 74 75 72 6e 20 5b 6c 69 73  nd...return [lis
5ec0: 74 20 24 66 64 20 5b 6c 69 73 74 20 6d 6b 63 6c  t $fd [list mkcl
5ed0: 5f 76 66 73 3a 3a 64 6f 5f 63 6c 6f 73 65 20 24  _vfs::do_close $
5ee0: 64 62 20 24 66 64 20 24 6d 6f 64 65 20 24 73 62  db $fd $mode $sb
5ef0: 28 69 6e 6f 29 5d 5d 0a 09 20 20 20 20 7d 0a 09  (ino)]]..    }..
5f00: 20 20 20 20 77 2a 20 20 7b 0a 09 09 69 66 20 7b      w*  {...if {
5f10: 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a  $::mkcl_vfs::v::
5f20: 6d 6f 64 65 28 24 64 62 29 20 3d 3d 20 22 72 65  mode($db) == "re
5f30: 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 09 20 20 20  adonly"} {...   
5f40: 20 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 6d   vfs::filesystem
5f50: 20 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a 76   posixerror $::v
5f60: 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53 29  fs::posix(EROFS)
5f70: 0a 09 09 7d 0a 09 09 69 66 20 7b 20 5b 63 61 74  ...}...if { [cat
5f80: 63 68 20 7b 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a  ch {::mkcl_vfs::
5f90: 73 74 61 74 20 24 64 62 20 24 66 69 6c 65 20 73  stat $db $file s
5fa0: 62 20 7d 5d 20 7d 20 7b 0a 09 09 20 20 20 20 23  b }] } {...    #
5fb0: 20 43 72 65 61 74 65 20 66 69 6c 65 0a 09 09 20   Create file... 
5fc0: 20 20 20 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 73     ::mkcl_vfs::s
5fd0: 74 61 74 20 24 64 62 20 5b 66 69 6c 65 20 64 69  tat $db [file di
5fe0: 72 6e 61 6d 65 20 24 66 69 6c 65 5d 20 73 62 0a  rname $file] sb.
5ff0: 09 09 20 20 20 20 73 65 74 20 74 61 69 6c 20 5b  ..    set tail [
6000: 66 69 6c 65 20 74 61 69 6c 20 24 66 69 6c 65 5d  file tail $file]
6010: 0a 09 09 20 20 20 20 73 65 74 20 66 76 69 65 77  ...    set fview
6020: 20 24 73 62 28 69 6e 6f 29 2e 66 69 6c 65 73 0a   $sb(ino).files.
6030: 09 09 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20  ..    if {[info 
6040: 65 78 69 73 74 73 20 6d 6b 63 6c 5f 76 66 73 3a  exists mkcl_vfs:
6050: 3a 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 65  :v::fcache($fvie
6060: 77 29 5d 7d 20 7b 0a 09 09 09 6c 61 70 70 65 6e  w)]} {....lappen
6070: 64 20 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a 66  d mkcl_vfs::v::f
6080: 63 61 63 68 65 28 24 66 76 69 65 77 29 20 24 74  cache($fview) $t
6090: 61 69 6c 0a 09 09 20 20 20 20 7d 0a 09 09 20 20  ail...    }...  
60a0: 20 20 73 65 74 20 6e 6f 77 20 5b 63 6c 6f 63 6b    set now [clock
60b0: 20 73 65 63 6f 6e 64 73 5d 0a 09 09 20 20 20 20   seconds]...    
60c0: 73 65 74 20 73 62 28 69 6e 6f 29 20 5b 72 65 61  set sb(ino) [rea
60d0: 64 6b 69 74 3a 3a 72 6f 77 20 61 70 70 65 6e 64  dkit::row append
60e0: 20 24 66 76 69 65 77 20 5c 0a 09 09 09 20 20 20   $fview \....   
60f0: 20 6e 61 6d 65 20 24 74 61 69 6c 20 73 69 7a 65   name $tail size
6100: 20 30 20 64 61 74 65 20 24 6e 6f 77 20 5d 0a 09   0 date $now ]..
6110: 09 7d 0a 0a 09 09 69 66 20 7b 20 5b 73 74 72 69  .}....if { [stri
6120: 6e 67 20 6d 61 74 63 68 20 2a 7a 2a 20 24 6d 6f  ng match *z* $mo
6130: 64 65 5d 20 7c 7c 20 24 6d 6b 63 6c 5f 76 66 73  de] || $mkcl_vfs
6140: 3a 3a 63 6f 6d 70 72 65 73 73 20 7d 20 7b 0a 09  ::compress } {..
6150: 09 20 20 20 20 61 70 70 65 6e 64 20 6d 6f 64 65  .    append mode
6160: 20 7a 0a 09 09 20 20 20 20 73 65 74 20 66 64 20   z...    set fd 
6170: 5b 76 66 73 3a 3a 6d 65 6d 63 68 61 6e 5d 0a 09  [vfs::memchan]..
6180: 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20  .} else {...    
6190: 73 65 74 20 66 64 20 5b 72 65 61 64 6b 69 74 3a  set fd [readkit:
61a0: 3a 63 68 61 6e 6e 65 6c 20 24 73 62 28 69 6e 6f  :channel $sb(ino
61b0: 29 20 63 6f 6e 74 65 6e 74 73 20 77 5d 0a 09 09  ) contents w]...
61c0: 7d 0a 09 09 72 65 74 75 72 6e 20 5b 6c 69 73 74  }...return [list
61d0: 20 24 66 64 20 5b 6c 69 73 74 20 6d 6b 63 6c 5f   $fd [list mkcl_
61e0: 76 66 73 3a 3a 64 6f 5f 63 6c 6f 73 65 20 24 64  vfs::do_close $d
61f0: 62 20 24 66 64 20 24 6d 6f 64 65 20 24 73 62 28  b $fd $mode $sb(
6200: 69 6e 6f 29 5d 5d 0a 09 20 20 20 20 7d 0a 09 20  ino)]]..    }.. 
6210: 20 20 20 64 65 66 61 75 6c 74 20 20 20 7b 0a 09     default   {..
6220: 09 65 72 72 6f 72 20 22 69 6c 6c 65 67 61 6c 20  .error "illegal 
6230: 61 63 63 65 73 73 20 6d 6f 64 65 20 5c 22 24 6d  access mode \"$m
6240: 6f 64 65 5c 22 22 0a 09 20 20 20 20 7d 0a 09 7d  ode\""..    }..}
6250: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63  .    }..    proc
6260: 20 63 72 65 61 74 65 64 69 72 65 63 74 6f 72 79   createdirectory
6270: 20 7b 64 62 20 6e 61 6d 65 7d 20 7b 0a 09 6d 6b   {db name} {..mk
6280: 63 6c 5f 76 66 73 3a 3a 6d 6b 64 69 72 20 24 64  cl_vfs::mkdir $d
6290: 62 20 24 6e 61 6d 65 0a 20 20 20 20 7d 0a 0a 20  b $name.    }.. 
62a0: 20 20 20 70 72 6f 63 20 72 65 6d 6f 76 65 64 69     proc removedi
62b0: 72 65 63 74 6f 72 79 20 7b 64 62 20 6e 61 6d 65  rectory {db name
62c0: 20 72 65 63 75 72 73 69 76 65 7d 20 7b 0a 09 6d   recursive} {..m
62d0: 6b 63 6c 5f 76 66 73 3a 3a 64 65 6c 65 74 65 20  kcl_vfs::delete 
62e0: 24 64 62 20 24 6e 61 6d 65 20 24 72 65 63 75 72  $db $name $recur
62f0: 73 69 76 65 0a 20 20 20 20 7d 0a 0a 20 20 20 20  sive.    }..    
6300: 70 72 6f 63 20 64 65 6c 65 74 65 66 69 6c 65 20  proc deletefile 
6310: 7b 64 62 20 6e 61 6d 65 7d 20 7b 0a 09 6d 6b 63  {db name} {..mkc
6320: 6c 5f 76 66 73 3a 3a 64 65 6c 65 74 65 20 24 64  l_vfs::delete $d
6330: 62 20 24 6e 61 6d 65 0a 20 20 20 20 7d 0a 0a 20  b $name.    }.. 
6340: 20 20 20 70 72 6f 63 20 66 69 6c 65 61 74 74 72     proc fileattr
6350: 69 62 75 74 65 73 20 7b 64 62 20 72 6f 6f 74 20  ibutes {db root 
6360: 72 65 6c 61 74 69 76 65 20 61 72 67 73 7d 20 7b  relative args} {
6370: 0a 09 73 77 69 74 63 68 20 2d 2d 20 5b 6c 6c 65  ..switch -- [lle
6380: 6e 67 74 68 20 24 61 72 67 73 5d 20 7b 0a 09 20  ngth $args] {.. 
6390: 20 20 20 30 20 7b 0a 09 09 23 20 6c 69 73 74 20     0 {...# list 
63a0: 73 74 72 69 6e 67 73 0a 09 09 72 65 74 75 72 6e  strings...return
63b0: 20 5b 3a 3a 76 66 73 3a 3a 6c 69 73 74 41 74 74   [::vfs::listAtt
63c0: 72 69 62 75 74 65 73 5d 0a 09 20 20 20 20 7d 0a  ributes]..    }.
63d0: 09 20 20 20 20 31 20 7b 0a 09 09 23 20 67 65 74  .    1 {...# get
63e0: 20 76 61 6c 75 65 0a 09 09 73 65 74 20 69 6e 64   value...set ind
63f0: 65 78 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73  ex [lindex $args
6400: 20 30 5d 0a 09 09 72 65 74 75 72 6e 20 5b 3a 3a   0]...return [::
6410: 76 66 73 3a 3a 61 74 74 72 69 62 75 74 65 73 47  vfs::attributesG
6420: 65 74 20 24 72 6f 6f 74 20 24 72 65 6c 61 74 69  et $root $relati
6430: 76 65 20 24 69 6e 64 65 78 5d 0a 0a 09 20 20 20  ve $index]...   
6440: 20 7d 0a 09 20 20 20 20 32 20 7b 0a 09 09 23 20   }..    2 {...# 
6450: 73 65 74 20 76 61 6c 75 65 0a 09 09 69 66 20 7b  set value...if {
6460: 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a  $::mkcl_vfs::v::
6470: 6d 6f 64 65 28 24 64 62 29 20 3d 3d 20 22 72 65  mode($db) == "re
6480: 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 09 20 20 20  adonly"} {...   
6490: 20 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 6d   vfs::filesystem
64a0: 20 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a 76   posixerror $::v
64b0: 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53 29  fs::posix(EROFS)
64c0: 0a 09 09 7d 0a 09 09 73 65 74 20 69 6e 64 65 78  ...}...set index
64d0: 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20 30   [lindex $args 0
64e0: 5d 0a 09 09 73 65 74 20 76 61 6c 20 5b 6c 69 6e  ]...set val [lin
64f0: 64 65 78 20 24 61 72 67 73 20 31 5d 0a 09 09 72  dex $args 1]...r
6500: 65 74 75 72 6e 20 5b 3a 3a 76 66 73 3a 3a 61 74  eturn [::vfs::at
6510: 74 72 69 62 75 74 65 73 53 65 74 20 24 72 6f 6f  tributesSet $roo
6520: 74 20 24 72 65 6c 61 74 69 76 65 20 24 69 6e 64  t $relative $ind
6530: 65 78 20 24 76 61 6c 5d 0a 09 20 20 20 20 7d 0a  ex $val]..    }.
6540: 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 6e 61 6d 65  .}.    }.}..name
6550: 73 70 61 63 65 20 65 76 61 6c 20 6d 6b 63 6c 5f  space eval mkcl_
6560: 76 66 73 20 7b 0a 20 20 20 20 76 61 72 69 61 62  vfs {.    variab
6570: 6c 65 20 63 6f 6d 70 72 65 73 73 20 31 20 20 20  le compress 1   
6580: 20 20 3b 23 20 48 41 43 4b 20 2d 20 6e 65 65 64    ;# HACK - need
6590: 73 20 74 6f 20 62 65 20 70 61 72 74 20 6f 66 20  s to be part of 
65a0: 22 53 75 70 65 72 2d 42 6c 6f 63 6b 22 0a 20 20  "Super-Block".  
65b0: 20 20 76 61 72 69 61 62 6c 65 20 66 6c 75 73 68    variable flush
65c0: 20 20 20 20 35 30 30 30 20 20 3b 23 20 41 75 74      5000  ;# Aut
65d0: 6f 2d 43 6f 6d 6d 69 74 20 66 72 65 71 75 65 6e  o-Commit frequen
65e0: 63 79 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20  cy.    variable 
65f0: 64 69 72 65 63 74 20 20 20 30 09 20 20 20 20 3b  direct   0.    ;
6600: 23 20 72 65 61 64 20 74 68 72 6f 75 67 68 20 61  # read through a
6610: 20 6d 65 6d 63 68 61 6e 2c 20 6f 72 20 66 72 6f   memchan, or fro
6620: 6d 20 4d 6b 34 74 63 6c 20 69 66 20 7a 65 72 6f  m Mk4tcl if zero
6630: 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 7a 73  .    variable zs
6640: 74 72 65 61 6d 65 64 20 31 20 20 20 20 3b 23 20  treamed 1    ;# 
6650: 64 65 63 6f 6d 70 72 65 73 73 20 6f 6e 20 74 68  decompress on th
6660: 65 20 66 6c 79 20 28 6e 65 65 64 73 20 7a 6c 69  e fly (needs zli
6670: 62 20 31 2e 31 29 0a 0a 20 20 20 20 6e 61 6d 65  b 1.1)..    name
6680: 73 70 61 63 65 20 65 76 61 6c 20 76 20 7b 0a 09  space eval v {..
6690: 76 61 72 69 61 62 6c 65 20 73 65 71 20 20 20 20  variable seq    
66a0: 20 20 30 0a 09 76 61 72 69 61 62 6c 65 20 6d 6f    0..variable mo
66b0: 64 65 09 20 20 20 20 3b 23 20 61 72 72 61 79 20  de.    ;# array 
66c0: 6b 65 79 20 69 73 20 64 62 2c 20 76 61 6c 75 65  key is db, value
66d0: 20 69 73 20 6d 6f 64 65 20 0a 09 20 20 20 20 20   is mode ..     
66e0: 20 20 20 20 20 20 20 20 09 20 20 20 20 20 23 20          .     # 
66f0: 28 72 65 61 64 77 72 69 74 65 2f 74 72 61 6e 73  (readwrite/trans
6700: 6c 75 63 65 6e 74 2f 72 65 61 64 6f 6e 6c 79 29  lucent/readonly)
6710: 0a 09 76 61 72 69 61 62 6c 65 20 74 69 6d 65 72  ..variable timer
6720: 09 20 20 20 20 3b 23 20 61 72 72 61 79 20 6b 65  .    ;# array ke
6730: 79 20 69 73 20 64 62 2c 20 73 65 74 20 74 6f 20  y is db, set to 
6740: 61 66 74 65 72 69 64 2c 20 70 65 72 69 6f 64 69  afterid, periodi
6750: 63 43 6f 6d 6d 69 74 0a 0a 09 61 72 72 61 79 20  cCommit...array 
6760: 73 65 74 20 63 61 63 68 65 20 7b 7d 0a 09 61 72  set cache {}..ar
6770: 72 61 79 20 73 65 74 20 66 63 61 63 68 65 20 7b  ray set fcache {
6780: 7d 0a 0a 09 61 72 72 61 79 20 73 65 74 20 6d 6f  }...array set mo
6790: 64 65 20 7b 65 78 65 20 74 72 61 6e 73 6c 75 63  de {exe transluc
67a0: 65 6e 74 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20  ent}.    }..    
67b0: 70 72 6f 63 20 69 6e 69 74 20 7b 64 62 7d 20 7b  proc init {db} {
67c0: 0a 09 72 65 61 64 6b 69 74 3a 3a 76 69 65 77 20  ..readkit::view 
67d0: 6c 61 79 6f 75 74 20 24 64 62 2e 64 69 72 73 20  layout $db.dirs 
67e0: 5c 0a 09 09 7b 6e 61 6d 65 3a 53 20 70 61 72 65  \...{name:S pare
67f0: 6e 74 3a 49 20 7b 66 69 6c 65 73 20 7b 6e 61 6d  nt:I {files {nam
6800: 65 3a 53 20 73 69 7a 65 3a 49 20 64 61 74 65 3a  e:S size:I date:
6810: 49 20 63 6f 6e 74 65 6e 74 73 3a 4d 7d 7d 7d 0a  I contents:M}}}.
6820: 0a 09 69 66 20 7b 20 5b 72 65 61 64 6b 69 74 3a  ..if { [readkit:
6830: 3a 76 69 65 77 20 73 69 7a 65 20 24 64 62 2e 64  :view size $db.d
6840: 69 72 73 5d 20 3d 3d 20 30 20 7d 20 7b 0a 09 20  irs] == 0 } {.. 
6850: 20 20 20 72 65 61 64 6b 69 74 3a 3a 72 6f 77 20     readkit::row 
6860: 61 70 70 65 6e 64 20 24 64 62 2e 64 69 72 73 20  append $db.dirs 
6870: 6e 61 6d 65 20 3c 72 6f 6f 74 3e 20 70 61 72 65  name <root> pare
6880: 6e 74 20 2d 31 0a 09 7d 0a 20 20 20 20 7d 0a 0a  nt -1..}.    }..
6890: 20 20 20 20 70 72 6f 63 20 5f 6d 6f 75 6e 74 20      proc _mount 
68a0: 7b 7b 66 69 6c 65 20 22 22 7d 20 61 72 67 73 7d  {{file ""} args}
68b0: 20 7b 0a 09 73 65 74 20 64 62 20 6d 6b 34 76 66   {..set db mk4vf
68c0: 73 5b 69 6e 63 72 20 76 3a 3a 73 65 71 5d 0a 0a  s[incr v::seq]..
68d0: 09 69 66 20 7b 24 66 69 6c 65 20 3d 3d 20 22 22  .if {$file == ""
68e0: 7d 20 7b 0a 09 20 20 20 20 72 65 61 64 6b 69 74  } {..    readkit
68f0: 3a 3a 66 69 6c 65 20 6f 70 65 6e 20 24 64 62 0a  ::file open $db.
6900: 09 20 20 20 20 69 6e 69 74 20 24 64 62 0a 09 20  .    init $db.. 
6910: 20 20 20 73 65 74 20 76 3a 3a 6d 6f 64 65 28 24     set v::mode($
6920: 64 62 29 20 22 74 72 61 6e 73 6c 75 63 65 6e 74  db) "translucent
6930: 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20  "..} else {..   
6940: 20 65 76 61 6c 20 5b 6c 69 73 74 20 72 65 61 64   eval [list read
6950: 6b 69 74 3a 3a 66 69 6c 65 20 6f 70 65 6e 20 24  kit::file open $
6960: 64 62 20 24 66 69 6c 65 5d 20 24 61 72 67 73 0a  db $file] $args.
6970: 09 20 20 20 20 0a 09 20 20 20 20 69 6e 69 74 20  .    ..    init 
6980: 24 64 62 0a 09 20 20 20 20 0a 09 20 20 20 20 73  $db..    ..    s
6990: 65 74 20 6d 6f 64 65 20 30 0a 09 20 20 20 20 66  et mode 0..    f
69a0: 6f 72 65 61 63 68 20 61 72 67 20 24 61 72 67 73  oreach arg $args
69b0: 20 7b 0a 09 09 73 77 69 74 63 68 20 2d 2d 20 24   {...switch -- $
69c0: 61 72 67 20 7b 0a 09 09 20 20 20 20 2d 72 65 61  arg {...    -rea
69d0: 64 6f 6e 6c 79 20 20 20 7b 20 73 65 74 20 6d 6f  donly   { set mo
69e0: 64 65 20 31 20 7d 0a 09 09 20 20 20 20 2d 6e 6f  de 1 }...    -no
69f0: 63 6f 6d 6d 69 74 20 20 20 7b 20 73 65 74 20 6d  commit   { set m
6a00: 6f 64 65 20 32 20 7d 0a 09 09 7d 0a 09 20 20 20  ode 2 }...}..   
6a10: 20 7d 0a 09 20 20 20 20 69 66 20 7b 24 6d 6f 64   }..    if {$mod
6a20: 65 20 3d 3d 20 30 7d 20 7b 0a 09 09 70 65 72 69  e == 0} {...peri
6a30: 6f 64 69 63 43 6f 6d 6d 69 74 20 24 64 62 0a 09  odicCommit $db..
6a40: 20 20 20 20 7d 0a 09 20 20 20 20 73 65 74 20 76      }..    set v
6a50: 3a 3a 6d 6f 64 65 28 24 64 62 29 20 5b 6c 69 6e  ::mode($db) [lin
6a60: 64 65 78 20 7b 74 72 61 6e 73 6c 75 63 65 6e 74  dex {translucent
6a70: 20 72 65 61 64 77 72 69 74 65 20 72 65 61 64 77   readwrite readw
6a80: 72 69 74 65 7d 20 24 6d 6f 64 65 5d 0a 09 7d 0a  rite} $mode]..}.
6a90: 09 72 65 74 75 72 6e 20 24 64 62 0a 20 20 20 20  .return $db.    
6aa0: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 70 65 72 69  }..    proc peri
6ab0: 6f 64 69 63 43 6f 6d 6d 69 74 20 7b 64 62 7d 20  odicCommit {db} 
6ac0: 7b 0a 09 76 61 72 69 61 62 6c 65 20 66 6c 75 73  {..variable flus
6ad0: 68 0a 09 73 65 74 20 76 3a 3a 74 69 6d 65 72 28  h..set v::timer(
6ae0: 24 64 62 29 20 5b 61 66 74 65 72 20 24 66 6c 75  $db) [after $flu
6af0: 73 68 20 5b 6c 69 73 74 20 3a 3a 6d 6b 63 6c 5f  sh [list ::mkcl_
6b00: 76 66 73 3a 3a 70 65 72 69 6f 64 69 63 43 6f 6d  vfs::periodicCom
6b10: 6d 69 74 20 24 64 62 5d 5d 0a 09 72 65 61 64 6b  mit $db]]..readk
6b20: 69 74 3a 3a 66 69 6c 65 20 63 6f 6d 6d 69 74 20  it::file commit 
6b30: 24 64 62 0a 09 72 65 74 75 72 6e 20 3b 23 20 32  $db..return ;# 2
6b40: 30 30 35 2d 30 31 2d 32 30 20 61 76 6f 69 64 20  005-01-20 avoid 
6b50: 72 65 74 75 72 6e 69 6e 67 20 61 20 76 61 6c 75  returning a valu
6b60: 65 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f  e.    }..    pro
6b70: 63 20 5f 75 6d 6f 75 6e 74 20 7b 64 62 20 61 72  c _umount {db ar
6b80: 67 73 7d 20 7b 0a 09 63 61 74 63 68 20 7b 61 66  gs} {..catch {af
6b90: 74 65 72 20 63 61 6e 63 65 6c 20 24 76 3a 3a 74  ter cancel $v::t
6ba0: 69 6d 65 72 28 24 64 62 29 7d 0a 09 61 72 72 61  imer($db)}..arra
6bb0: 79 20 75 6e 73 65 74 20 76 3a 3a 6d 6f 64 65 20  y unset v::mode 
6bc0: 24 64 62 0a 09 61 72 72 61 79 20 75 6e 73 65 74  $db..array unset
6bd0: 20 76 3a 3a 74 69 6d 65 72 20 24 64 62 0a 09 61   v::timer $db..a
6be0: 72 72 61 79 20 75 6e 73 65 74 20 76 3a 3a 63 61  rray unset v::ca
6bf0: 63 68 65 20 24 64 62 2c 2a 0a 09 61 72 72 61 79  che $db,*..array
6c00: 20 75 6e 73 65 74 20 76 3a 3a 66 63 61 63 68 65   unset v::fcache
6c10: 20 24 64 62 2e 2a 0a 09 72 65 61 64 6b 69 74 3a   $db.*..readkit:
6c20: 3a 66 69 6c 65 20 63 6c 6f 73 65 20 24 64 62 0a  :file close $db.
6c30: 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20      }..    proc 
6c40: 73 74 61 74 20 7b 64 62 20 70 61 74 68 20 7b 61  stat {db path {a
6c50: 72 72 20 22 22 7d 7d 20 7b 0a 09 73 65 74 20 73  rr ""}} {..set s
6c60: 70 20 5b 3a 3a 66 69 6c 65 20 73 70 6c 69 74 20  p [::file split 
6c70: 24 70 61 74 68 5d 0a 09 73 65 74 20 74 61 69 6c  $path]..set tail
6c80: 20 5b 6c 69 6e 64 65 78 20 24 73 70 20 65 6e 64   [lindex $sp end
6c90: 5d 0a 0a 09 73 65 74 20 70 61 72 65 6e 74 20 30  ]...set parent 0
6ca0: 0a 09 73 65 74 20 76 69 65 77 20 24 64 62 2e 64  ..set view $db.d
6cb0: 69 72 73 0a 09 73 65 74 20 74 79 70 65 20 64 69  irs..set type di
6cc0: 72 65 63 74 6f 72 79 0a 0a 09 66 6f 72 65 61 63  rectory...foreac
6cd0: 68 20 65 6c 65 20 5b 6c 72 61 6e 67 65 20 24 73  h ele [lrange $s
6ce0: 70 20 30 20 65 6e 64 2d 31 5d 20 7b 0a 09 20 20  p 0 end-1] {..  
6cf0: 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73    if {[info exis
6d00: 74 73 20 76 3a 3a 63 61 63 68 65 28 24 64 62 2c  ts v::cache($db,
6d10: 24 70 61 72 65 6e 74 2c 24 65 6c 65 29 5d 7d 20  $parent,$ele)]} 
6d20: 7b 0a 09 09 73 65 74 20 70 61 72 65 6e 74 20 24  {...set parent $
6d30: 76 3a 3a 63 61 63 68 65 28 24 64 62 2c 24 70 61  v::cache($db,$pa
6d40: 72 65 6e 74 2c 24 65 6c 65 29 0a 09 20 20 20 20  rent,$ele)..    
6d50: 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 72  } else {...set r
6d60: 6f 77 20 5b 72 65 61 64 6b 69 74 3a 3a 73 65 6c  ow [readkit::sel
6d70: 65 63 74 20 24 76 69 65 77 20 2d 63 6f 75 6e 74  ect $view -count
6d80: 20 31 20 70 61 72 65 6e 74 20 24 70 61 72 65 6e   1 parent $paren
6d90: 74 20 6e 61 6d 65 20 24 65 6c 65 5d 0a 09 09 69  t name $ele]...i
6da0: 66 20 7b 20 24 72 6f 77 20 3d 3d 20 22 22 20 7d  f { $row == "" }
6db0: 20 7b 0a 09 09 20 20 20 20 76 66 73 3a 3a 66 69   {...    vfs::fi
6dc0: 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 65 72  lesystem posixer
6dd0: 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f 73 69  ror $::vfs::posi
6de0: 78 28 45 4e 4f 45 4e 54 29 0a 09 09 7d 0a 09 09  x(ENOENT)...}...
6df0: 73 65 74 20 76 3a 3a 63 61 63 68 65 28 24 64 62  set v::cache($db
6e00: 2c 24 70 61 72 65 6e 74 2c 24 65 6c 65 29 20 24  ,$parent,$ele) $
6e10: 72 6f 77 0a 09 09 73 65 74 20 70 61 72 65 6e 74  row...set parent
6e20: 20 24 72 6f 77 0a 09 20 20 20 20 7d 0a 09 7d 0a   $row..    }..}.
6e30: 09 0a 09 23 20 4e 6f 77 20 63 68 65 63 6b 20 69  ...# Now check i
6e40: 66 20 66 69 6e 61 6c 20 63 6f 6d 70 20 69 73 20  f final comp is 
6e50: 61 20 64 69 72 65 63 74 6f 72 79 20 6f 72 20 61  a directory or a
6e60: 20 66 69 6c 65 0a 09 23 20 43 41 43 48 49 4e 47   file..# CACHING
6e70: 20 69 73 20 72 65 71 75 69 72 65 64 20 2d 20 69   is required - i
6e80: 74 20 63 61 6e 20 64 65 6c 69 76 65 72 20 61 20  t can deliver a 
6e90: 78 31 35 20 73 70 65 65 64 2d 75 70 21 0a 09 0a  x15 speed-up!...
6ea0: 09 69 66 20 7b 20 5b 73 74 72 69 6e 67 20 65 71  .if { [string eq
6eb0: 75 61 6c 20 24 74 61 69 6c 20 22 2e 22 5d 20 7c  ual $tail "."] |
6ec0: 7c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c 20  | [string equal 
6ed0: 24 74 61 69 6c 20 22 3a 22 5d 20 5c 0a 09 20 20  $tail ":"] \..  
6ee0: 7c 7c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c  || [string equal
6ef0: 20 24 74 61 69 6c 20 22 22 5d 20 7d 20 7b 0a 09   $tail ""] } {..
6f00: 20 20 20 20 73 65 74 20 72 6f 77 20 24 70 61 72      set row $par
6f10: 65 6e 74 0a 0a 09 7d 20 65 6c 73 65 69 66 20 7b  ent...} elseif {
6f20: 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 76 3a   [info exists v:
6f30: 3a 63 61 63 68 65 28 24 64 62 2c 24 70 61 72 65  :cache($db,$pare
6f40: 6e 74 2c 24 74 61 69 6c 29 5d 20 7d 20 7b 0a 09  nt,$tail)] } {..
6f50: 20 20 20 20 73 65 74 20 72 6f 77 20 24 76 3a 3a      set row $v::
6f60: 63 61 63 68 65 28 24 64 62 2c 24 70 61 72 65 6e  cache($db,$paren
6f70: 74 2c 24 74 61 69 6c 29 0a 09 7d 20 65 6c 73 65  t,$tail)..} else
6f80: 20 7b 0a 09 20 20 20 20 23 20 46 69 6c 65 3f 0a   {..    # File?.
6f90: 09 20 20 20 20 73 65 74 20 66 76 69 65 77 20 24  .    set fview $
6fa0: 76 69 65 77 21 24 70 61 72 65 6e 74 2e 66 69 6c  view!$parent.fil
6fb0: 65 73 0a 09 20 20 20 20 23 20 63 72 65 61 74 65  es..    # create
6fc0: 20 61 20 6e 61 6d 65 20 63 61 63 68 65 20 6f 66   a name cache of
6fd0: 20 66 69 6c 65 73 20 69 6e 20 74 68 69 73 20 64   files in this d
6fe0: 69 72 65 63 74 6f 72 79 0a 09 20 20 20 20 69 66  irectory..    if
6ff0: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20   {![info exists 
7000: 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 65 77  v::fcache($fview
7010: 29 5d 7d 20 7b 0a 09 09 23 20 63 61 63 68 65 20  )]} {...# cache 
7020: 6f 6e 6c 79 20 61 20 6c 69 6d 69 74 65 64 20 6e  only a limited n
7030: 75 6d 62 65 72 20 6f 66 20 64 69 72 65 63 74 6f  umber of directo
7040: 72 69 65 73 0a 09 09 69 66 20 7b 5b 61 72 72 61  ries...if {[arra
7050: 79 20 73 69 7a 65 20 76 3a 3a 66 63 61 63 68 65  y size v::fcache
7060: 5d 20 3e 3d 20 31 30 7d 20 7b 0a 09 09 20 20 20  ] >= 10} {...   
7070: 20 61 72 72 61 79 20 75 6e 73 65 74 20 76 3a 3a   array unset v::
7080: 66 63 61 63 68 65 20 2a 0a 09 09 7d 0a 09 09 73  fcache *...}...s
7090: 65 74 20 76 3a 3a 66 63 61 63 68 65 28 24 66 76  et v::fcache($fv
70a0: 69 65 77 29 20 7b 7d 0a 09 09 72 65 61 64 6b 69  iew) {}...readki
70b0: 74 3a 3a 6c 6f 6f 70 20 63 20 24 66 76 69 65 77  t::loop c $fview
70c0: 20 7b 0a 09 09 20 20 20 20 6c 61 70 70 65 6e 64   {...    lappend
70d0: 20 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 65   v::fcache($fvie
70e0: 77 29 20 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74  w) [readkit::get
70f0: 20 24 63 20 6e 61 6d 65 5d 0a 09 09 7d 0a 09 20   $c name]...}.. 
7100: 20 20 20 7d 0a 09 20 20 20 20 73 65 74 20 72 6f     }..    set ro
7110: 77 20 5b 6c 73 65 61 72 63 68 20 2d 65 78 61 63  w [lsearch -exac
7120: 74 20 24 76 3a 3a 66 63 61 63 68 65 28 24 66 76  t $v::fcache($fv
7130: 69 65 77 29 20 24 74 61 69 6c 5d 0a 09 20 20 20  iew) $tail]..   
7140: 20 23 73 65 74 20 72 6f 77 20 5b 72 65 61 64 6b   #set row [readk
7150: 69 74 3a 3a 73 65 6c 65 63 74 20 24 66 76 69 65  it::select $fvie
7160: 77 20 2d 63 6f 75 6e 74 20 31 20 6e 61 6d 65 20  w -count 1 name 
7170: 24 74 61 69 6c 5d 0a 09 20 20 20 20 23 69 66 20  $tail]..    #if 
7180: 7b 24 72 6f 77 20 3d 3d 20 22 22 7d 20 7b 20 73  {$row == ""} { s
7190: 65 74 20 72 6f 77 20 2d 31 20 7d 0a 09 20 20 20  et row -1 }..   
71a0: 20 69 66 20 7b 20 24 72 6f 77 20 21 3d 20 2d 31   if { $row != -1
71b0: 20 7d 20 7b 0a 09 09 73 65 74 20 74 79 70 65 20   } {...set type 
71c0: 66 69 6c 65 0a 09 09 73 65 74 20 76 69 65 77 20  file...set view 
71d0: 24 76 69 65 77 21 24 70 61 72 65 6e 74 2e 66 69  $view!$parent.fi
71e0: 6c 65 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20  les..    } else 
71f0: 7b 0a 09 09 23 20 44 69 72 65 63 74 6f 72 79 3f  {...# Directory?
7200: 0a 09 09 73 65 74 20 72 6f 77 20 5b 72 65 61 64  ...set row [read
7210: 6b 69 74 3a 3a 73 65 6c 65 63 74 20 24 76 69 65  kit::select $vie
7220: 77 20 2d 63 6f 75 6e 74 20 31 20 70 61 72 65 6e  w -count 1 paren
7230: 74 20 24 70 61 72 65 6e 74 20 6e 61 6d 65 20 24  t $parent name $
7240: 74 61 69 6c 5d 0a 09 09 69 66 20 7b 20 24 72 6f  tail]...if { $ro
7250: 77 20 21 3d 20 22 22 20 7d 20 7b 0a 09 09 20 20  w != "" } {...  
7260: 20 20 73 65 74 20 76 3a 3a 63 61 63 68 65 28 24    set v::cache($
7270: 64 62 2c 24 70 61 72 65 6e 74 2c 24 74 61 69 6c  db,$parent,$tail
7280: 29 20 24 72 6f 77 0a 09 09 7d 20 65 6c 73 65 20  ) $row...} else 
7290: 7b 20 0a 09 09 20 20 20 20 76 66 73 3a 3a 66 69  { ...    vfs::fi
72a0: 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 65 72  lesystem posixer
72b0: 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f 73 69  ror $::vfs::posi
72c0: 78 28 45 4e 4f 45 4e 54 29 0a 09 09 7d 0a 09 20  x(ENOENT)...}.. 
72d0: 20 20 20 7d 0a 09 7d 0a 20 0a 20 20 20 20 20 20     }..}. .      
72e0: 20 20 69 66 20 7b 21 5b 73 74 72 69 6e 67 20 6c    if {![string l
72f0: 65 6e 67 74 68 20 24 61 72 72 5d 7d 20 7b 0a 20  ength $arr]} {. 
7300: 20 20 20 20 20 20 20 20 20 20 20 23 20 54 68 65             # The
7310: 20 63 61 6c 6c 65 72 20 64 6f 65 73 6e 27 74 20   caller doesn't 
7320: 6e 65 65 64 20 6d 6f 72 65 20 64 65 74 61 69 6c  need more detail
7330: 65 64 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 2e 0a  ed information..
7340: 20 20 20 20 20 20 20 20 20 20 20 20 72 65 74 75              retu
7350: 72 6e 20 31 0a 20 20 20 20 20 20 20 20 7d 0a 20  rn 1.        }. 
7360: 0a 09 73 65 74 20 63 75 72 20 24 76 69 65 77 21  ..set cur $view!
7370: 24 72 6f 77 0a 0a 09 75 70 76 61 72 20 31 20 24  $row...upvar 1 $
7380: 61 72 72 20 73 62 0a 0a 09 73 65 74 20 73 62 28  arr sb...set sb(
7390: 74 79 70 65 29 20 20 20 20 24 74 79 70 65 0a 09  type)    $type..
73a0: 73 65 74 20 73 62 28 76 69 65 77 29 20 20 20 20  set sb(view)    
73b0: 24 76 69 65 77 0a 09 73 65 74 20 73 62 28 69 6e  $view..set sb(in
73c0: 6f 29 20 20 20 20 20 24 63 75 72 0a 0a 09 69 66  o)     $cur...if
73d0: 20 7b 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c   { [string equal
73e0: 20 24 74 79 70 65 20 22 64 69 72 65 63 74 6f 72   $type "director
73f0: 79 22 5d 20 7d 20 7b 0a 09 20 20 20 20 73 65 74  y"] } {..    set
7400: 20 73 62 28 61 74 69 6d 65 29 20 30 0a 09 20 20   sb(atime) 0..  
7410: 20 20 73 65 74 20 73 62 28 63 74 69 6d 65 29 20    set sb(ctime) 
7420: 30 0a 09 20 20 20 20 73 65 74 20 73 62 28 67 69  0..    set sb(gi
7430: 64 29 20 20 20 30 0a 09 20 20 20 20 73 65 74 20  d)   0..    set 
7440: 73 62 28 6d 6f 64 65 29 20 20 30 37 37 37 0a 09  sb(mode)  0777..
7450: 20 20 20 20 73 65 74 20 73 62 28 6d 74 69 6d 65      set sb(mtime
7460: 29 20 30 0a 09 20 20 20 20 73 65 74 20 73 62 28  ) 0..    set sb(
7470: 6e 6c 69 6e 6b 29 20 5b 65 78 70 72 20 7b 20 5b  nlink) [expr { [
7480: 72 65 61 64 6b 69 74 3a 3a 67 65 74 20 24 63 75  readkit::get $cu
7490: 72 20 66 69 6c 65 73 5d 20 2b 20 31 20 7d 5d 0a  r files] + 1 }].
74a0: 09 20 20 20 20 73 65 74 20 73 62 28 73 69 7a 65  .    set sb(size
74b0: 29 20 20 30 0a 09 20 20 20 20 73 65 74 20 73 62  )  0..    set sb
74c0: 28 63 73 69 7a 65 29 20 30 0a 09 20 20 20 20 73  (csize) 0..    s
74d0: 65 74 20 73 62 28 75 69 64 29 20 20 20 30 0a 09  et sb(uid)   0..
74e0: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65  } else {..    se
74f0: 74 20 6d 74 69 6d 65 20 20 20 5b 72 65 61 64 6b  t mtime   [readk
7500: 69 74 3a 3a 67 65 74 20 24 63 75 72 20 64 61 74  it::get $cur dat
7510: 65 5d 0a 09 20 20 20 20 73 65 74 20 73 62 28 61  e]..    set sb(a
7520: 74 69 6d 65 29 20 24 6d 74 69 6d 65 0a 09 20 20  time) $mtime..  
7530: 20 20 73 65 74 20 73 62 28 63 74 69 6d 65 29 20    set sb(ctime) 
7540: 24 6d 74 69 6d 65 0a 09 20 20 20 20 73 65 74 20  $mtime..    set 
7550: 73 62 28 67 69 64 29 20 20 20 30 0a 09 20 20 20  sb(gid)   0..   
7560: 20 73 65 74 20 73 62 28 6d 6f 64 65 29 20 20 30   set sb(mode)  0
7570: 37 37 37 0a 09 20 20 20 20 73 65 74 20 73 62 28  777..    set sb(
7580: 6d 74 69 6d 65 29 20 24 6d 74 69 6d 65 0a 09 20  mtime) $mtime.. 
7590: 20 20 20 73 65 74 20 73 62 28 6e 6c 69 6e 6b 29     set sb(nlink)
75a0: 20 31 0a 09 20 20 20 20 73 65 74 20 73 62 28 73   1..    set sb(s
75b0: 69 7a 65 29 20 20 5b 72 65 61 64 6b 69 74 3a 3a  ize)  [readkit::
75c0: 67 65 74 20 24 63 75 72 20 73 69 7a 65 5d 0a 09  get $cur size]..
75d0: 20 20 20 20 73 65 74 20 73 62 28 63 73 69 7a 65      set sb(csize
75e0: 29 20 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74 20  ) [readkit::get 
75f0: 24 63 75 72 20 2d 73 69 7a 65 20 63 6f 6e 74 65  $cur -size conte
7600: 6e 74 73 5d 0a 09 20 20 20 20 73 65 74 20 73 62  nts]..    set sb
7610: 28 75 69 64 29 20 20 20 30 0a 09 7d 0a 20 20 20  (uid)   0..}.   
7620: 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 64 6f 5f   }..    proc do_
7630: 63 6c 6f 73 65 20 7b 64 62 20 66 64 20 6d 6f 64  close {db fd mod
7640: 65 20 63 75 72 7d 20 7b 0a 09 69 66 20 7b 21 5b  e cur} {..if {![
7650: 72 65 67 65 78 70 20 7b 5b 61 77 5d 7d 20 24 6d  regexp {[aw]} $m
7660: 6f 64 65 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72  ode]} {..    err
7670: 6f 72 20 22 6d 6b 63 6c 5f 76 66 73 3a 3a 64 6f  or "mkcl_vfs::do
7680: 5f 63 6c 6f 73 65 20 63 61 6c 6c 65 64 20 77 69  _close called wi
7690: 74 68 20 62 61 64 20 6d 6f 64 65 3a 20 24 6d 6f  th bad mode: $mo
76a0: 64 65 22 0a 09 7d 0a 0a 09 72 65 61 64 6b 69 74  de"..}...readkit
76b0: 3a 3a 73 65 74 20 24 63 75 72 20 73 69 7a 65 20  ::set $cur size 
76c0: 2d 31 20 64 61 74 65 20 5b 63 6c 6f 63 6b 20 73  -1 date [clock s
76d0: 65 63 6f 6e 64 73 5d 0a 09 66 6c 75 73 68 20 24  econds]..flush $
76e0: 66 64 0a 09 69 66 20 7b 20 5b 73 74 72 69 6e 67  fd..if { [string
76f0: 20 6d 61 74 63 68 20 2a 7a 2a 20 24 6d 6f 64 65   match *z* $mode
7700: 5d 20 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66  ] } {..    fconf
7710: 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 6e 73  igure $fd -trans
7720: 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a 09 20  lation binary.. 
7730: 20 20 20 73 65 65 6b 20 24 66 64 20 30 0a 09 20     seek $fd 0.. 
7740: 20 20 20 73 65 74 20 64 61 74 61 20 5b 72 65 61     set data [rea
7750: 64 20 24 66 64 5d 0a 09 20 20 20 20 73 65 74 20  d $fd]..    set 
7760: 63 64 61 74 61 20 5b 76 66 73 3a 3a 7a 69 70 20  cdata [vfs::zip 
7770: 2d 6d 6f 64 65 20 63 6f 6d 70 72 65 73 73 20 24  -mode compress $
7780: 64 61 74 61 5d 0a 09 20 20 20 20 73 65 74 20 6c  data]..    set l
7790: 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74  en [string lengt
77a0: 68 20 24 64 61 74 61 5d 0a 09 20 20 20 20 73 65  h $data]..    se
77b0: 74 20 63 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c  t clen [string l
77c0: 65 6e 67 74 68 20 24 63 64 61 74 61 5d 0a 09 20  ength $cdata].. 
77d0: 20 20 20 69 66 20 7b 20 24 63 6c 65 6e 20 3c 20     if { $clen < 
77e0: 24 6c 65 6e 20 7d 20 7b 0a 09 09 72 65 61 64 6b  $len } {...readk
77f0: 69 74 3a 3a 73 65 74 20 24 63 75 72 20 73 69 7a  it::set $cur siz
7800: 65 20 24 6c 65 6e 20 63 6f 6e 74 65 6e 74 73 20  e $len contents 
7810: 24 63 64 61 74 61 0a 09 20 20 20 20 7d 20 65 6c  $cdata..    } el
7820: 73 65 20 7b 0a 09 09 72 65 61 64 6b 69 74 3a 3a  se {...readkit::
7830: 73 65 74 20 24 63 75 72 20 73 69 7a 65 20 24 6c  set $cur size $l
7840: 65 6e 20 63 6f 6e 74 65 6e 74 73 20 24 64 61 74  en contents $dat
7850: 61 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65  a..    }..} else
7860: 20 7b 0a 09 20 20 20 20 72 65 61 64 6b 69 74 3a   {..    readkit:
7870: 3a 73 65 74 20 24 63 75 72 20 73 69 7a 65 20 5b  :set $cur size [
7880: 72 65 61 64 6b 69 74 3a 3a 67 65 74 20 24 63 75  readkit::get $cu
7890: 72 20 2d 73 69 7a 65 20 63 6f 6e 74 65 6e 74 73  r -size contents
78a0: 5d 0a 09 7d 0a 09 23 20 31 36 6f 63 74 30 32 20  ]..}..# 16oct02 
78b0: 6e 65 77 20 6c 6f 67 69 63 20 74 6f 20 73 74 61  new logic to sta
78c0: 72 74 20 61 20 70 65 72 69 6f 64 69 63 20 63 6f  rt a periodic co
78d0: 6d 6d 69 74 20 74 69 6d 65 72 20 69 66 20 6e 6f  mmit timer if no
78e0: 74 20 79 65 74 20 72 75 6e 6e 69 6e 67 0a 09 73  t yet running..s
78f0: 65 74 75 70 43 6f 6d 6d 69 74 73 20 24 64 62 0a  etupCommits $db.
7900: 09 72 65 74 75 72 6e 20 22 22 0a 20 20 20 20 7d  .return "".    }
7910: 0a 0a 20 20 20 20 70 72 6f 63 20 73 65 74 75 70  ..    proc setup
7920: 43 6f 6d 6d 69 74 73 20 7b 64 62 7d 20 7b 0a 09  Commits {db} {..
7930: 69 66 20 7b 24 76 3a 3a 6d 6f 64 65 28 24 64 62  if {$v::mode($db
7940: 29 20 65 71 20 22 72 65 61 64 77 72 69 74 65 22  ) eq "readwrite"
7950: 20 26 26 20 21 5b 69 6e 66 6f 20 65 78 69 73 74   && ![info exist
7960: 73 20 76 3a 3a 74 69 6d 65 72 28 24 64 62 29 5d  s v::timer($db)]
7970: 7d 20 7b 0a 09 20 20 20 20 70 65 72 69 6f 64 69  } {..    periodi
7980: 63 43 6f 6d 6d 69 74 20 24 64 62 0a 09 20 20 20  cCommit $db..   
7990: 20 72 65 61 64 6b 69 74 3a 3a 66 69 6c 65 20 61   readkit::file a
79a0: 75 74 6f 63 6f 6d 6d 69 74 20 24 64 62 0a 09 7d  utocommit $db..}
79b0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63  .    }..    proc
79c0: 20 6d 6b 64 69 72 20 7b 64 62 20 70 61 74 68 7d   mkdir {db path}
79d0: 20 7b 0a 09 69 66 20 7b 24 76 3a 3a 6d 6f 64 65   {..if {$v::mode
79e0: 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 6f 6e  ($db) == "readon
79f0: 6c 79 22 7d 20 7b 0a 09 20 20 20 20 76 66 73 3a  ly"} {..    vfs:
7a00: 3a 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69  :filesystem posi
7a10: 78 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70  xerror $::vfs::p
7a20: 6f 73 69 78 28 45 52 4f 46 53 29 0a 09 7d 0a 09  osix(EROFS)..}..
7a30: 73 65 74 20 73 70 20 5b 3a 3a 66 69 6c 65 20 73  set sp [::file s
7a40: 70 6c 69 74 20 24 70 61 74 68 5d 0a 09 73 65 74  plit $path]..set
7a50: 20 70 61 72 65 6e 74 20 30 0a 09 73 65 74 20 76   parent 0..set v
7a60: 69 65 77 20 24 64 62 2e 64 69 72 73 0a 0a 09 73  iew $db.dirs...s
7a70: 65 74 20 6e 70 61 74 68 20 7b 7d 0a 09 23 20 54  et npath {}..# T
7a80: 68 69 73 20 61 63 74 75 61 6c 6c 79 20 64 6f 65  his actually doe
7a90: 73 20 6d 6f 72 65 20 77 6f 72 6b 20 74 68 61 6e  s more work than
7aa0: 20 69 73 20 6e 65 65 64 65 64 2e 20 54 63 6c 27   is needed. Tcl'
7ab0: 73 0a 09 23 20 76 66 73 20 6f 6e 6c 79 20 72 65  s..# vfs only re
7ac0: 71 75 69 72 65 73 20 75 73 20 74 6f 20 63 72 65  quires us to cre
7ad0: 61 74 65 20 74 68 65 20 6c 61 73 74 20 70 69 65  ate the last pie
7ae0: 63 65 2c 20 61 6e 64 0a 09 23 20 54 63 6c 20 61  ce, and..# Tcl a
7af0: 6c 72 65 61 64 79 20 6b 6e 6f 77 73 20 69 74 20  lready knows it 
7b00: 69 73 20 6e 6f 74 20 61 20 66 69 6c 65 2e 0a 09  is not a file...
7b10: 66 6f 72 65 61 63 68 20 65 6c 65 20 24 73 70 20  foreach ele $sp 
7b20: 7b 0a 09 20 20 20 20 73 65 74 20 6e 70 61 74 68  {..    set npath
7b30: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 6e 70 61   [file join $npa
7b40: 74 68 20 24 65 6c 65 5d 0a 0a 09 20 20 20 20 69  th $ele]...    i
7b50: 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 74 61 74  f {![catch {stat
7b60: 20 24 64 62 20 24 6e 70 61 74 68 20 73 62 7d 5d   $db $npath sb}]
7b70: 20 7d 20 7b 0a 09 09 69 66 20 7b 20 24 73 62 28   } {...if { $sb(
7b80: 74 79 70 65 29 20 21 3d 20 22 64 69 72 65 63 74  type) != "direct
7b90: 6f 72 79 22 20 7d 20 7b 0a 09 09 20 20 20 20 76  ory" } {...    v
7ba0: 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20 70  fs::filesystem p
7bb0: 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a 76 66 73  osixerror $::vfs
7bc0: 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53 29 0a 09  ::posix(EROFS)..
7bd0: 09 7d 0a 09 09 73 65 74 20 70 61 72 65 6e 74 20  .}...set parent 
7be0: 5b 72 65 61 64 6b 69 74 3a 3a 63 75 72 73 6f 72  [readkit::cursor
7bf0: 20 70 6f 73 69 74 69 6f 6e 20 73 62 28 69 6e 6f   position sb(ino
7c00: 29 5d 0a 09 09 63 6f 6e 74 69 6e 75 65 0a 09 20  )]...continue.. 
7c10: 20 20 20 7d 0a 09 20 20 20 20 23 73 65 74 20 70     }..    #set p
7c20: 61 72 65 6e 74 20 5b 72 65 61 64 6b 69 74 3a 3a  arent [readkit::
7c30: 63 75 72 73 6f 72 20 70 6f 73 69 74 69 6f 6e 20  cursor position 
7c40: 73 62 28 69 6e 6f 29 5d 0a 09 20 20 20 20 73 65  sb(ino)]..    se
7c50: 74 20 63 75 72 20 5b 72 65 61 64 6b 69 74 3a 3a  t cur [readkit::
7c60: 72 6f 77 20 61 70 70 65 6e 64 20 24 76 69 65 77  row append $view
7c70: 20 6e 61 6d 65 20 24 65 6c 65 20 70 61 72 65 6e   name $ele paren
7c80: 74 20 24 70 61 72 65 6e 74 5d 0a 09 20 20 20 20  t $parent]..    
7c90: 73 65 74 20 70 61 72 65 6e 74 20 5b 72 65 61 64  set parent [read
7ca0: 6b 69 74 3a 3a 63 75 72 73 6f 72 20 70 6f 73 69  kit::cursor posi
7cb0: 74 69 6f 6e 20 63 75 72 5d 0a 09 7d 0a 09 73 65  tion cur]..}..se
7cc0: 74 75 70 43 6f 6d 6d 69 74 73 20 24 64 62 0a 09  tupCommits $db..
7cd0: 72 65 74 75 72 6e 20 22 22 0a 20 20 20 20 7d 0a  return "".    }.
7ce0: 0a 20 20 20 20 70 72 6f 63 20 67 65 74 64 69 72  .    proc getdir
7cf0: 20 7b 64 62 20 70 61 74 68 20 7b 70 61 74 20 2a   {db path {pat *
7d00: 7d 7d 20 7b 0a 09 69 66 20 7b 5b 63 61 74 63 68  }} {..if {[catch
7d10: 20 7b 20 73 74 61 74 20 24 64 62 20 24 70 61 74   { stat $db $pat
7d20: 68 20 73 62 20 7d 5d 20 7c 7c 20 24 73 62 28 74  h sb }] || $sb(t
7d30: 79 70 65 29 20 21 3d 20 22 64 69 72 65 63 74 6f  ype) != "directo
7d40: 72 79 22 20 7d 20 7b 0a 09 20 20 20 20 72 65 74  ry" } {..    ret
7d50: 75 72 6e 0a 09 7d 0a 0a 09 23 20 4d 61 74 63 68  urn..}...# Match
7d60: 20 64 69 72 65 63 74 6f 72 69 65 73 0a 09 73 65   directories..se
7d70: 74 20 70 61 72 65 6e 74 20 5b 72 65 61 64 6b 69  t parent [readki
7d80: 74 3a 3a 63 75 72 73 6f 72 20 70 6f 73 69 74 69  t::cursor positi
7d90: 6f 6e 20 73 62 28 69 6e 6f 29 5d 20 0a 09 66 6f  on sb(ino)] ..fo
7da0: 72 65 61 63 68 20 72 6f 77 20 5b 72 65 61 64 6b  reach row [readk
7db0: 69 74 3a 3a 73 65 6c 65 63 74 20 24 73 62 28 76  it::select $sb(v
7dc0: 69 65 77 29 20 70 61 72 65 6e 74 20 24 70 61 72  iew) parent $par
7dd0: 65 6e 74 20 2d 67 6c 6f 62 20 6e 61 6d 65 20 24  ent -glob name $
7de0: 70 61 74 5d 20 7b 0a 09 20 20 20 20 73 65 74 20  pat] {..    set 
7df0: 68 69 74 73 28 5b 72 65 61 64 6b 69 74 3a 3a 67  hits([readkit::g
7e00: 65 74 20 24 73 62 28 76 69 65 77 29 21 24 72 6f  et $sb(view)!$ro
7e10: 77 20 6e 61 6d 65 5d 29 20 31 0a 09 7d 0a 09 23  w name]) 1..}..#
7e20: 20 4d 61 74 63 68 20 66 69 6c 65 73 0a 09 73 65   Match files..se
7e30: 74 20 76 69 65 77 20 24 73 62 28 76 69 65 77 29  t view $sb(view)
7e40: 21 24 70 61 72 65 6e 74 2e 66 69 6c 65 73 0a 09  !$parent.files..
7e50: 66 6f 72 65 61 63 68 20 72 6f 77 20 5b 72 65 61  foreach row [rea
7e60: 64 6b 69 74 3a 3a 73 65 6c 65 63 74 20 24 76 69  dkit::select $vi
7e70: 65 77 20 2d 67 6c 6f 62 20 6e 61 6d 65 20 24 70  ew -glob name $p
7e80: 61 74 5d 20 7b 0a 09 20 20 20 20 73 65 74 20 68  at] {..    set h
7e90: 69 74 73 28 5b 72 65 61 64 6b 69 74 3a 3a 67 65  its([readkit::ge
7ea0: 74 20 24 76 69 65 77 21 24 72 6f 77 20 6e 61 6d  t $view!$row nam
7eb0: 65 5d 29 20 31 0a 09 7d 0a 09 72 65 74 75 72 6e  e]) 1..}..return
7ec0: 20 5b 6c 73 6f 72 74 20 5b 61 72 72 61 79 20 6e   [lsort [array n
7ed0: 61 6d 65 73 20 68 69 74 73 5d 5d 0a 20 20 20 20  ames hits]].    
7ee0: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 74 69 6d  }..    proc mtim
7ef0: 65 20 7b 64 62 20 70 61 74 68 20 74 69 6d 65 7d  e {db path time}
7f00: 20 7b 0a 09 69 66 20 7b 24 76 3a 3a 6d 6f 64 65   {..if {$v::mode
7f10: 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 6f 6e  ($db) == "readon
7f20: 6c 79 22 7d 20 7b 0a 09 20 20 20 20 76 66 73 3a  ly"} {..    vfs:
7f30: 3a 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69  :filesystem posi
7f40: 78 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70  xerror $::vfs::p
7f50: 6f 73 69 78 28 45 52 4f 46 53 29 0a 09 7d 0a 09  osix(EROFS)..}..
7f60: 73 74 61 74 20 24 64 62 20 24 70 61 74 68 20 73  stat $db $path s
7f70: 62 0a 09 69 66 20 7b 20 24 73 62 28 74 79 70 65  b..if { $sb(type
7f80: 29 20 3d 3d 20 22 66 69 6c 65 22 20 7d 20 7b 0a  ) == "file" } {.
7f90: 09 20 20 20 20 72 65 61 64 6b 69 74 3a 3a 73 65  .    readkit::se
7fa0: 74 20 24 73 62 28 69 6e 6f 29 20 64 61 74 65 20  t $sb(ino) date 
7fb0: 24 74 69 6d 65 0a 09 7d 0a 09 72 65 74 75 72 6e  $time..}..return
7fc0: 20 24 74 69 6d 65 0a 20 20 20 20 7d 0a 0a 20 20   $time.    }..  
7fd0: 20 20 70 72 6f 63 20 64 65 6c 65 74 65 20 7b 64    proc delete {d
7fe0: 62 20 70 61 74 68 20 7b 72 65 63 75 72 73 69 76  b path {recursiv
7ff0: 65 20 30 7d 7d 20 7b 0a 09 23 70 75 74 73 20 73  e 0}} {..#puts s
8000: 74 64 65 72 72 20 22 6d 6b 34 64 65 6c 65 74 65  tderr "mk4delete
8010: 20 64 62 20 24 64 62 20 70 61 74 68 20 24 70 61   db $db path $pa
8020: 74 68 20 72 65 63 75 72 73 69 76 65 20 24 72 65  th recursive $re
8030: 63 75 72 73 69 76 65 22 0a 09 69 66 20 7b 24 76  cursive"..if {$v
8040: 3a 3a 6d 6f 64 65 28 24 64 62 29 20 3d 3d 20 22  ::mode($db) == "
8050: 72 65 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 20 20  readonly"} {..  
8060: 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65    vfs::filesyste
8070: 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a  m posixerror $::
8080: 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53  vfs::posix(EROFS
8090: 29 0a 09 7d 0a 09 73 74 61 74 20 24 64 62 20 24  )..}..stat $db $
80a0: 70 61 74 68 20 73 62 0a 09 69 66 20 7b 24 73 62  path sb..if {$sb
80b0: 28 74 79 70 65 29 20 3d 3d 20 22 66 69 6c 65 22  (type) == "file"
80c0: 20 7d 20 7b 0a 09 20 20 20 20 72 65 61 64 6b 69   } {..    readki
80d0: 74 3a 3a 72 6f 77 20 64 65 6c 65 74 65 20 24 73  t::row delete $s
80e0: 62 28 69 6e 6f 29 0a 09 20 20 20 20 69 66 20 7b  b(ino)..    if {
80f0: 5b 72 65 67 65 78 70 20 7b 28 2e 2a 29 21 28 5c  [regexp {(.*)!(\
8100: 64 2b 29 7d 20 24 73 62 28 69 6e 6f 29 20 2d 20  d+)} $sb(ino) - 
8110: 76 20 72 5d 20 5c 0a 09 09 20 20 20 20 26 26 20  v r] \...    && 
8120: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 76 3a 3a  [info exists v::
8130: 66 63 61 63 68 65 28 24 76 29 5d 7d 20 7b 0a 09  fcache($v)]} {..
8140: 09 73 65 74 20 76 3a 3a 66 63 61 63 68 65 28 24  .set v::fcache($
8150: 76 29 20 5b 6c 72 65 70 6c 61 63 65 20 24 76 3a  v) [lreplace $v:
8160: 3a 66 63 61 63 68 65 28 24 76 29 20 24 72 20 24  :fcache($v) $r $
8170: 72 5d 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73  r]..    }..} els
8180: 65 20 7b 0a 09 20 20 20 20 23 20 6a 75 73 74 20  e {..    # just 
8190: 6d 61 72 6b 20 64 69 72 73 20 61 73 20 64 65 6c  mark dirs as del
81a0: 65 74 65 64 0a 09 20 20 20 20 73 65 74 20 63 6f  eted..    set co
81b0: 6e 74 65 6e 74 73 20 5b 67 65 74 64 69 72 20 24  ntents [getdir $
81c0: 64 62 20 24 70 61 74 68 20 2a 5d 0a 09 20 20 20  db $path *]..   
81d0: 20 69 66 20 7b 24 72 65 63 75 72 73 69 76 65 7d   if {$recursive}
81e0: 20 7b 0a 09 09 23 20 57 65 20 68 61 76 65 20 74   {...# We have t
81f0: 6f 20 64 65 6c 65 74 65 20 74 68 65 73 65 20 6d  o delete these m
8200: 61 6e 75 61 6c 6c 79 2c 20 65 6c 73 65 0a 09 09  anually, else...
8210: 23 20 74 68 65 79 20 28 6f 72 20 74 68 65 69 72  # they (or their
8220: 20 63 61 63 68 65 29 20 6d 61 79 20 63 6f 6e 66   cache) may conf
8230: 6c 69 63 74 20 77 69 74 68 0a 09 09 23 20 73 6f  lict with...# so
8240: 6d 65 74 68 69 6e 67 20 6c 61 74 65 72 0a 09 09  mething later...
8250: 66 6f 72 65 61 63 68 20 66 20 24 63 6f 6e 74 65  foreach f $conte
8260: 6e 74 73 20 7b 0a 09 09 20 20 20 20 64 65 6c 65  nts {...    dele
8270: 74 65 20 24 64 62 20 5b 66 69 6c 65 20 6a 6f 69  te $db [file joi
8280: 6e 20 24 70 61 74 68 20 24 66 5d 20 24 72 65 63  n $path $f] $rec
8290: 75 72 73 69 76 65 0a 09 09 7d 0a 09 20 20 20 20  ursive...}..    
82a0: 7d 20 65 6c 73 65 20 7b 0a 09 09 69 66 20 7b 5b  } else {...if {[
82b0: 6c 6c 65 6e 67 74 68 20 24 63 6f 6e 74 65 6e 74  llength $content
82c0: 73 5d 7d 20 7b 0a 09 09 20 20 20 20 76 66 73 3a  s]} {...    vfs:
82d0: 3a 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69  :filesystem posi
82e0: 78 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70  xerror $::vfs::p
82f0: 6f 73 69 78 28 45 4e 4f 54 45 4d 50 54 59 29 0a  osix(ENOTEMPTY).
8300: 09 09 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20  ..}..    }..    
8310: 61 72 72 61 79 20 75 6e 73 65 74 20 76 3a 3a 63  array unset v::c
8320: 61 63 68 65 20 5c 0a 09 09 20 20 20 20 22 24 64  ache \...    "$d
8330: 62 2c 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74 20  b,[readkit::get 
8340: 24 73 62 28 69 6e 6f 29 20 70 61 72 65 6e 74 5d  $sb(ino) parent]
8350: 2c 5b 66 69 6c 65 20 74 61 69 6c 20 24 70 61 74  ,[file tail $pat
8360: 68 5d 22 0a 09 20 20 20 20 0a 09 20 20 20 20 23  h]"..    ..    #
8370: 20 66 6c 61 67 20 77 69 74 68 20 2d 39 39 2c 20   flag with -99, 
8380: 62 65 63 61 75 73 65 20 70 61 72 65 6e 74 20 2d  because parent -
8390: 31 20 69 73 20 6e 6f 74 20 72 65 73 65 72 76 65  1 is not reserve
83a0: 64 20 66 6f 72 20 74 68 65 20 72 6f 6f 74 20 64  d for the root d
83b0: 69 72 0a 09 20 20 20 20 23 20 64 65 6c 65 74 65  ir..    # delete
83c0: 64 20 65 6e 74 72 69 65 73 20 6e 65 76 65 72 20  d entries never 
83d0: 67 65 74 20 72 65 2d 75 73 65 64 2c 20 73 68 6f  get re-used, sho
83e0: 75 6c 64 20 62 65 20 63 6c 65 61 6e 65 64 20 75  uld be cleaned u
83f0: 70 20 6f 6e 65 20 64 61 79 0a 09 20 20 20 20 72  p one day..    r
8400: 65 61 64 6b 69 74 3a 3a 73 65 74 20 24 73 62 28  eadkit::set $sb(
8410: 69 6e 6f 29 20 70 61 72 65 6e 74 20 2d 39 39 20  ino) parent -99 
8420: 6e 61 6d 65 20 22 22 0a 09 20 20 20 20 23 20 67  name ""..    # g
8430: 65 74 20 72 69 64 20 6f 66 20 66 69 6c 65 20 65  et rid of file e
8440: 6e 74 72 69 65 73 20 74 6f 20 72 65 6c 65 61 73  ntries to releas
8450: 65 20 74 68 65 20 73 70 61 63 65 20 69 6e 20 74  e the space in t
8460: 68 65 20 64 61 74 61 66 69 6c 65 0a 09 20 20 20  he datafile..   
8470: 20 72 65 61 64 6b 69 74 3a 3a 76 69 65 77 20 73   readkit::view s
8480: 69 7a 65 20 24 73 62 28 69 6e 6f 29 2e 66 69 6c  ize $sb(ino).fil
8490: 65 73 20 30 0a 09 7d 0a 09 73 65 74 75 70 43 6f  es 0..}..setupCo
84a0: 6d 6d 69 74 73 20 24 64 62 0a 09 72 65 74 75 72  mmits $db..retur
84b0: 6e 20 22 22 0a 20 20 20 20 7d 0a 7d 0a 0a 70 61  n "".    }.}..pa
84c0: 63 6b 61 67 65 20 70 72 6f 76 69 64 65 20 72 65  ckage provide re
84d0: 61 64 6b 69 74 20 30 2e 38 0a 70 61 63 6b 61 67  adkit 0.8.packag
84e0: 65 20 70 72 6f 76 69 64 65 20 76 66 73 3a 3a 6d  e provide vfs::m
84f0: 6b 63 6c 20 32 2e 34 2e 30 2e 31 0a              kcl 2.4.0.1.