Hex Artifact Content

Artifact 77305dd8a03b2052f3d4eabcb1971d072407cc4f:


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 20 20 73 65   == ""} {.    se
0170: 74 20 61 75 74 6f 5f 69 6e 64 65 78 28 6c 61 73  t auto_index(las
0180: 73 69 67 6e 29 20 7b 0a 20 20 20 20 70 72 6f 63  sign) {.    proc
0190: 20 6c 61 73 73 69 67 6e 20 7b 6c 20 61 72 67 73   lassign {l args
01a0: 7d 20 7b 0a 20 20 20 20 20 20 66 6f 72 65 61 63  } {.      foreac
01b0: 68 20 76 20 24 6c 20 61 20 24 61 72 67 73 20 7b  h v $l a $args {
01c0: 20 75 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74   uplevel 1 [list
01d0: 20 73 65 74 20 24 61 20 24 76 5d 20 7d 0a 20 20   set $a $v] }.  
01e0: 20 20 7d 0a 20 20 7d 0a 7d 0a 0a 63 61 74 63 68    }.  }.}..catch
01f0: 20 7b 0a 09 6c 6f 61 64 20 7b 7d 20 7a 6c 69 62   {..load {} zlib
0200: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72  ..package requir
0210: 65 20 7a 6c 69 62 0a 7d 0a 0a 69 66 20 7b 5b 69  e zlib.}..if {[i
0220: 6e 66 6f 20 63 6f 6d 6d 20 6d 6d 61 70 5d 20 3d  nfo comm mmap] =
0230: 3d 20 22 22 7d 20 7b 0a 20 20 20 20 23 20 6d 6d  = ""} {.    # mm
0240: 61 70 20 61 6e 64 20 6d 76 65 63 20 70 72 69 6d  ap and mvec prim
0250: 69 74 69 76 65 73 20 69 6e 20 70 75 72 65 20 54  itives in pure T
0260: 63 6c 20 28 61 20 43 20 76 65 72 73 69 6f 6e 20  cl (a C version 
0270: 69 73 20 70 72 65 73 65 6e 74 20 69 6e 20 63 72  is present in cr
0280: 69 74 6c 69 62 29 0a 0a 20 20 20 20 6e 61 6d 65  itlib)..    name
0290: 73 70 61 63 65 20 65 78 70 6f 72 74 20 6d 6d 61  space export mma
02a0: 70 20 6d 76 65 63 0a 0a 20 20 20 20 6e 61 6d 65  p mvec..    name
02b0: 73 70 61 63 65 20 65 76 61 6c 20 76 20 7b 0a 09  space eval v {..
02c0: 61 72 72 61 79 20 73 65 74 20 6d 6d 61 70 5f 64  array set mmap_d
02d0: 61 74 61 20 7b 7d 0a 09 61 72 72 61 79 20 73 65  ata {}..array se
02e0: 74 20 6d 76 65 63 5f 73 68 69 66 74 73 20 7b 0a  t mvec_shifts {.
02f0: 20 20 20 20 2d 20 2d 31 20 20 20 20 30 20 2d 31      - -1    0 -1
0300: 0a 20 20 20 20 31 20 20 30 20 20 20 20 32 20 20  .    1  0    2  
0310: 31 20 20 20 20 34 20 20 32 20 20 20 20 38 20 20  1    4  2    8  
0320: 20 33 0a 20 20 20 20 31 36 20 34 20 20 20 31 36   3.    16 4   16
0330: 72 20 34 0a 20 20 20 20 33 32 20 35 20 20 20 33  r 4.    32 5   3
0340: 32 72 20 35 20 20 20 33 32 66 20 35 20 20 20 33  2r 5   32f 5   3
0350: 32 66 72 20 35 0a 20 20 20 20 36 34 20 36 20 20  2fr 5.    64 6  
0360: 20 36 34 72 20 36 20 20 20 36 34 66 20 36 20 20   64r 6   64f 6  
0370: 20 36 34 66 72 20 36 20 7d 0a 20 20 20 20 7d 0a   64fr 6 }.    }.
0380: 0a 20 20 20 20 70 72 6f 63 20 6d 6d 61 70 20 7b  .    proc mmap {
0390: 66 64 20 61 72 67 73 7d 20 7b 0a 09 75 70 76 61  fd args} {..upva
03a0: 72 20 23 30 20 76 3a 3a 6d 6d 61 70 5f 64 61 74  r #0 v::mmap_dat
03b0: 61 28 24 66 64 29 20 64 61 74 61 0a 09 23 20 73  a($fd) data..# s
03c0: 70 65 63 69 61 6c 20 63 61 73 65 20 69 66 20 66  pecial case if f
03d0: 64 20 69 73 20 74 68 65 20 6e 61 6d 65 20 6f 66  d is the name of
03e0: 20 61 20 76 61 72 69 61 62 6c 65 20 28 71 75 61   a variable (qua
03f0: 6c 69 66 69 65 64 20 6f 72 20 67 6c 6f 62 61 6c  lified or global
0400: 29 0a 09 69 66 20 7b 5b 75 70 6c 65 76 65 6c 20  )..if {[uplevel 
0410: 23 30 20 5b 6c 69 73 74 20 69 6e 66 6f 20 65 78  #0 [list info ex
0420: 69 73 74 73 20 24 66 64 5d 5d 7d 20 7b 0a 09 20  ists $fd]]} {.. 
0430: 20 20 20 75 70 76 61 72 20 23 30 20 24 66 64 20     upvar #0 $fd 
0440: 76 61 72 0a 09 20 20 20 20 73 65 74 20 64 61 74  var..    set dat
0450: 61 20 24 76 61 72 0a 09 7d 0a 09 23 20 63 61 63  a $var..}..# cac
0460: 68 65 20 61 20 66 75 6c 6c 20 63 6f 70 79 20 6f  he a full copy o
0470: 66 20 74 68 65 20 66 69 6c 65 20 74 6f 20 73 69  f the file to si
0480: 6d 75 6c 61 74 65 20 6d 65 6d 6f 72 79 20 6d 61  mulate memory ma
0490: 70 70 69 6e 67 0a 09 69 66 20 7b 21 5b 69 6e 66  pping..if {![inf
04a0: 6f 20 65 78 69 73 74 73 20 64 61 74 61 5d 7d 20  o exists data]} 
04b0: 7b 0a 09 20 20 20 20 73 65 74 20 70 6f 73 20 5b  {..    set pos [
04c0: 74 65 6c 6c 20 24 66 64 5d 0a 09 20 20 20 20 73  tell $fd]..    s
04d0: 65 65 6b 20 24 66 64 20 30 20 65 6e 64 0a 09 20  eek $fd 0 end.. 
04e0: 20 20 20 73 65 74 20 65 6e 64 20 5b 74 65 6c 6c     set end [tell
04f0: 20 24 66 64 5d 0a 09 20 20 20 20 73 65 65 6b 20   $fd]..    seek 
0500: 24 66 64 20 30 0a 09 20 20 20 20 73 65 74 20 74  $fd 0..    set t
0510: 72 61 6e 73 20 5b 66 63 6f 6e 66 69 67 75 72 65  rans [fconfigure
0520: 20 24 66 64 20 2d 74 72 61 6e 73 6c 61 74 69 6f   $fd -translatio
0530: 6e 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75  n]..    fconfigu
0540: 72 65 20 24 66 64 20 2d 74 72 61 6e 73 6c 61 74  re $fd -translat
0550: 69 6f 6e 20 62 69 6e 61 72 79 0a 09 20 20 20 20  ion binary..    
0560: 73 65 74 20 64 61 74 61 20 5b 72 65 61 64 20 24  set data [read $
0570: 66 64 20 24 65 6e 64 5d 0a 09 20 20 20 20 66 63  fd $end]..    fc
0580: 6f 6e 66 69 67 75 72 65 20 24 66 64 20 2d 74 72  onfigure $fd -tr
0590: 61 6e 73 6c 61 74 69 6f 6e 20 24 74 72 61 6e 73  anslation $trans
05a0: 0a 09 20 20 20 20 73 65 65 6b 20 24 66 64 20 24  ..    seek $fd $
05b0: 70 6f 73 0a 09 7d 0a 09 73 65 74 20 74 6f 74 61  pos..}..set tota
05c0: 6c 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68  l [string length
05d0: 20 24 64 61 74 61 5d 0a 09 69 66 20 7b 5b 6c 6c   $data]..if {[ll
05e0: 65 6e 67 74 68 20 24 61 72 67 73 5d 20 3d 3d 20  ength $args] == 
05f0: 30 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e  0} {..    return
0600: 20 24 74 6f 74 61 6c 0a 09 7d 0a 09 66 6f 72 65   $total..}..fore
0610: 61 63 68 20 7b 6f 66 66 20 6c 65 6e 7d 20 24 61  ach {off len} $a
0620: 72 67 73 20 62 72 65 61 6b 0a 09 69 66 20 7b 24  rgs break..if {$
0630: 6c 65 6e 20 3c 20 30 7d 20 7b 0a 09 20 20 20 20  len < 0} {..    
0640: 73 65 74 20 6c 65 6e 20 24 74 6f 74 61 6c 0a 09  set len $total..
0650: 7d 0a 09 69 66 20 7b 24 6c 65 6e 20 3c 20 30 20  }..if {$len < 0 
0660: 7c 7c 20 24 6c 65 6e 20 3e 20 24 74 6f 74 61 6c  || $len > $total
0670: 20 2d 20 24 6f 66 66 7d 20 7b 0a 09 20 20 20 20   - $off} {..    
0680: 73 65 74 20 6c 65 6e 20 5b 65 78 70 72 20 7b 24  set len [expr {$
0690: 74 6f 74 61 6c 20 2d 20 24 6f 66 66 7d 5d 0a 09  total - $off}]..
06a0: 7d 0a 09 62 69 6e 61 72 79 20 73 63 61 6e 20 24  }..binary scan $
06b0: 64 61 74 61 20 40 24 7b 6f 66 66 7d 61 24 6c 65  data @${off}a$le
06c0: 6e 20 73 0a 09 72 65 74 75 72 6e 20 24 73 0a 20  n s..return $s. 
06d0: 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d     }..    proc m
06e0: 76 65 63 20 7b 76 20 61 72 67 73 7d 20 7b 0a 09  vec {v args} {..
06f0: 66 6f 72 65 61 63 68 20 7b 6d 6f 64 65 20 64 61  foreach {mode da
0700: 74 61 20 6f 66 66 20 6c 65 6e 7d 20 24 76 20 62  ta off len} $v b
0710: 72 65 61 6b 0a 09 69 66 20 7b 5b 69 6e 66 6f 20  reak..if {[info 
0720: 65 78 69 73 74 73 20 76 3a 3a 6d 76 65 63 5f 73  exists v::mvec_s
0730: 68 69 66 74 73 28 24 6d 6f 64 65 29 5d 7d 20 7b  hifts($mode)]} {
0740: 0a 09 20 20 20 20 23 20 75 73 65 20 5f 6d 76 65  ..    # use _mve
0750: 63 5f 67 65 74 20 74 6f 20 61 63 63 65 73 73 20  c_get to access 
0760: 65 6c 65 6d 65 6e 74 73 0a 09 20 20 20 20 73 65  elements..    se
0770: 74 20 73 68 69 66 74 20 24 76 3a 3a 6d 76 65 63  t shift $v::mvec
0780: 5f 73 68 69 66 74 73 28 24 6d 6f 64 65 29 0a 09  _shifts($mode)..
0790: 20 20 20 20 69 66 20 7b 5b 6c 6c 65 6e 67 74 68      if {[llength
07a0: 20 24 76 5d 20 3c 20 34 7d 20 7b 0a 09 09 73 65   $v] < 4} {...se
07b0: 74 20 6c 65 6e 20 24 6f 66 66 0a 09 20 20 20 20  t len $off..    
07c0: 7d 0a 09 20 20 20 20 73 65 74 20 67 65 74 20 5b  }..    set get [
07d0: 6c 69 73 74 20 5f 6d 76 65 63 5f 67 65 74 20 24  list _mvec_get $
07e0: 73 68 69 66 74 20 24 76 20 2a 5d 0a 09 7d 20 65  shift $v *]..} e
07f0: 6c 73 65 20 7b 0a 09 20 20 20 20 23 20 76 69 72  lse {..    # vir
0800: 74 75 61 6c 20 6d 6f 64 65 2c 20 73 65 74 20 74  tual mode, set t
0810: 6f 20 65 76 61 6c 75 61 74 65 20 73 63 72 69 70  o evaluate scrip
0820: 74 0a 09 20 20 20 20 73 65 74 20 73 68 69 66 74  t..    set shift
0830: 20 22 22 0a 09 20 20 20 20 73 65 74 20 6c 65 6e   ""..    set len
0840: 20 5b 6c 69 6e 64 65 78 20 24 76 20 65 6e 64 5d   [lindex $v end]
0850: 0a 09 20 20 20 20 73 65 74 20 67 65 74 20 24 76  ..    set get $v
0860: 0a 09 7d 0a 09 23 20 74 72 79 20 74 6f 20 64 65  ..}..# try to de
0870: 72 69 76 65 20 76 65 63 74 6f 72 20 6c 65 6e 67  rive vector leng
0880: 74 68 20 66 72 6f 6d 20 64 61 74 61 20 6c 65 6e  th from data len
0890: 67 74 68 20 69 66 20 6e 6f 74 20 73 70 65 63 69  gth if not speci
08a0: 66 69 65 64 0a 09 69 66 20 7b 24 6c 65 6e 20 3d  fied..if {$len =
08b0: 3d 20 22 22 20 7c 7c 20 24 6c 65 6e 20 3c 20 30  = "" || $len < 0
08c0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 65 6e  } {..    set len
08d0: 20 30 0a 09 20 20 20 20 69 66 20 7b 24 73 68 69   0..    if {$shi
08e0: 66 74 20 3e 3d 20 30 7d 20 7b 0a 09 09 69 66 20  ft >= 0} {...if 
08f0: 7b 5b 6c 6c 65 6e 67 74 68 20 24 76 5d 20 3c 20  {[llength $v] < 
0900: 34 7d 20 7b 0a 09 09 20 20 20 20 73 65 74 20 6e  4} {...    set n
0910: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20   [string length 
0920: 24 64 61 74 61 5d 0a 09 09 7d 20 65 6c 73 65 20  $data]...} else 
0930: 7b 0a 09 09 20 20 20 20 73 65 74 20 6e 20 5b 6d  {...    set n [m
0940: 6d 61 70 20 24 64 61 74 61 5d 0a 09 09 7d 0a 09  map $data]...}..
0950: 09 73 65 74 20 6c 65 6e 20 5b 65 78 70 72 20 7b  .set len [expr {
0960: 28 24 6e 20 3c 3c 20 33 29 20 3e 3e 20 24 73 68  ($n << 3) >> $sh
0970: 69 66 74 7d 5d 0a 09 20 20 20 20 7d 0a 09 7d 0a  ift}]..    }..}.
0980: 09 73 65 74 20 6e 61 72 67 73 20 5b 6c 6c 65 6e  .set nargs [llen
0990: 67 74 68 20 24 61 72 67 73 5d 0a 09 23 20 77 69  gth $args]..# wi
09a0: 74 68 20 6a 75 73 74 20 61 20 76 61 72 6e 61 6d  th just a varnam
09b0: 65 20 61 73 20 61 72 67 2c 20 72 65 74 75 72 6e  e as arg, return
09c0: 20 69 6e 66 6f 20 61 62 6f 75 74 20 74 68 69 73   info about this
09d0: 20 76 65 63 74 6f 72 0a 09 69 66 20 7b 24 6e 61   vector..if {$na
09e0: 72 67 73 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20  rgs == 0} {..   
09f0: 20 69 66 20 7b 24 73 68 69 66 74 20 3d 3d 20 22   if {$shift == "
0a00: 22 7d 20 7b 0a 09 09 72 65 74 75 72 6e 20 5b 6c  "} {...return [l
0a10: 69 73 74 20 24 6c 65 6e 20 7b 7d 20 24 76 5d 0a  ist $len {} $v].
0a20: 09 20 20 20 20 7d 0a 09 20 20 20 20 72 65 74 75  .    }..    retu
0a30: 72 6e 20 5b 6c 69 73 74 20 24 6c 65 6e 20 24 6d  rn [list $len $m
0a40: 6f 64 65 20 24 73 68 69 66 74 5d 0a 09 7d 0a 09  ode $shift]..}..
0a50: 66 6f 72 65 61 63 68 20 7b 70 6f 73 20 63 6f 75  foreach {pos cou
0a60: 6e 74 20 70 72 65 64 20 63 6f 6e 64 7d 20 24 61  nt pred cond} $a
0a70: 72 67 73 20 62 72 65 61 6b 0a 09 23 20 77 69 74  rgs break..# wit
0a80: 68 20 61 6e 20 69 6e 64 65 78 20 61 73 20 73 65  h an index as se
0a90: 63 6f 6e 64 20 61 72 67 2c 20 64 6f 20 61 20 73  cond arg, do a s
0aa0: 69 6e 67 6c 65 20 61 63 63 65 73 73 20 61 6e 64  ingle access and
0ab0: 20 72 65 74 75 72 6e 20 65 6c 65 6d 65 6e 74 0a   return element.
0ac0: 09 69 66 20 7b 24 6e 61 72 67 73 20 3d 3d 20 31  .if {$nargs == 1
0ad0: 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 20  } {..    return 
0ae0: 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 72 65 70  [uplevel 1 [lrep
0af0: 6c 61 63 65 20 24 67 65 74 20 65 6e 64 20 65 6e  lace $get end en
0b00: 64 20 24 70 6f 73 5d 5d 0a 09 7d 0a 09 69 66 20  d $pos]]..}..if 
0b10: 7b 24 63 6f 75 6e 74 20 3c 20 30 7d 20 7b 0a 09  {$count < 0} {..
0b20: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 24 6c      set count $l
0b30: 65 6e 0a 09 7d 0a 09 69 66 20 7b 24 63 6f 75 6e  en..}..if {$coun
0b40: 74 20 3e 20 24 6c 65 6e 20 2d 20 24 70 6f 73 20  t > $len - $pos 
0b50: 26 26 20 24 73 68 69 66 74 20 21 3d 20 2d 31 7d  && $shift != -1}
0b60: 20 7b 0a 09 20 20 20 20 73 65 74 20 63 6f 75 6e   {..    set coun
0b70: 74 20 5b 65 78 70 72 20 7b 24 6c 65 6e 20 2d 20  t [expr {$len - 
0b80: 24 70 6f 73 7d 5d 0a 09 7d 0a 09 69 66 20 7b 24  $pos}]..}..if {$
0b90: 6e 61 72 67 73 20 3d 3d 20 34 7d 20 7b 0a 09 20  nargs == 4} {.. 
0ba0: 20 20 20 75 70 76 61 72 20 24 70 72 65 64 20 78     upvar $pred x
0bb0: 0a 09 7d 0a 09 73 65 74 20 72 20 7b 7d 0a 09 69  ..}..set r {}..i
0bc0: 6e 63 72 20 63 6f 75 6e 74 20 24 70 6f 73 0a 09  ncr count $pos..
0bd0: 23 20 6c 6f 6f 70 20 74 68 72 6f 75 67 68 20 73  # loop through s
0be0: 70 65 63 69 66 69 65 64 20 72 61 6e 67 65 20 74  pecified range t
0bf0: 6f 20 62 75 69 6c 64 20 72 65 73 75 6c 74 20 76  o build result v
0c00: 65 63 74 6f 72 0a 09 23 20 77 69 74 68 20 66 6f  ector..# with fo
0c10: 75 72 20 61 72 67 73 2c 20 75 73 65 64 20 74 68  ur args, used th
0c20: 61 74 20 61 73 20 70 72 65 64 69 63 61 74 65 20  at as predicate 
0c30: 66 75 6e 63 74 69 6f 6e 20 74 6f 20 66 69 6c 74  function to filt
0c40: 65 72 0a 09 23 20 77 69 74 68 20 66 69 76 65 20  er..# with five 
0c50: 61 72 67 73 2c 20 75 73 65 20 66 6f 75 72 74 68  args, use fourth
0c60: 20 61 73 20 6c 6f 6f 70 20 76 61 72 20 61 6e 64   as loop var and
0c70: 20 61 70 70 6c 79 20 66 69 66 74 68 20 61 73 20   apply fifth as 
0c80: 63 6f 6e 64 69 74 69 6f 6e 0a 09 66 6f 72 20 7b  condition..for {
0c90: 73 65 74 20 78 20 24 70 6f 73 7d 20 7b 24 78 20  set x $pos} {$x 
0ca0: 3c 20 24 63 6f 75 6e 74 7d 20 7b 69 6e 63 72 20  < $count} {incr 
0cb0: 78 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 79 20  x} {..    set y 
0cc0: 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 72 65 70  [uplevel 1 [lrep
0cd0: 6c 61 63 65 20 24 67 65 74 20 65 6e 64 20 65 6e  lace $get end en
0ce0: 64 20 24 78 5d 5d 0a 09 20 20 20 20 73 77 69 74  d $x]]..    swit
0cf0: 63 68 20 24 6e 61 72 67 73 20 7b 0a 09 09 33 20  ch $nargs {...3 
0d00: 7b 0a 09 09 09 69 66 20 7b 21 5b 75 70 6c 65 76  {....if {![uplev
0d10: 65 6c 20 31 20 5b 6c 69 73 74 20 24 70 72 65 64  el 1 [list $pred
0d20: 20 24 76 20 24 78 20 24 79 5d 5d 7d 20 63 6f 6e   $v $x $y]]} con
0d30: 74 69 6e 75 65 0a 09 09 20 20 20 20 7d 0a 09 09  tinue...    }...
0d40: 34 20 7b 0a 09 09 09 69 66 20 7b 21 5b 75 70 6c  4 {....if {![upl
0d50: 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 65 78 70  evel 1 [list exp
0d60: 72 20 24 63 6f 6e 64 5d 5d 7d 20 63 6f 6e 74 69  r $cond]]} conti
0d70: 6e 75 65 0a 09 09 20 20 20 20 7d 0a 09 20 20 20  nue...    }..   
0d80: 20 7d 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 20   }..    lappend 
0d90: 72 20 24 79 0a 09 7d 0a 09 72 65 74 75 72 6e 20  r $y..}..return 
0da0: 24 72 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72  $r.    }..    pr
0db0: 6f 63 20 5f 6d 76 65 63 5f 67 65 74 20 7b 73 68  oc _mvec_get {sh
0dc0: 69 66 74 20 64 65 73 63 20 69 6e 64 65 78 7d 20  ift desc index} 
0dd0: 7b 0a 09 66 6f 72 65 61 63 68 20 7b 6d 6f 64 65  {..foreach {mode
0de0: 20 64 61 74 61 20 6f 66 66 20 6c 65 6e 7d 20 24   data off len} $
0df0: 64 65 73 63 20 62 72 65 61 6b 0a 09 73 77 69 74  desc break..swit
0e00: 63 68 20 2d 2d 20 24 6d 6f 64 65 20 7b 0a 09 20  ch -- $mode {.. 
0e10: 20 20 20 2d 20 7b 0a 09 09 20 20 20 20 72 65 74     - {...    ret
0e20: 75 72 6e 20 24 69 6e 64 65 78 0a 09 09 7d 0a 09  urn $index...}..
0e30: 20 20 20 20 30 20 7b 0a 09 09 20 20 20 20 72 65      0 {...    re
0e40: 74 75 72 6e 20 24 64 61 74 61 0a 09 09 7d 0a 09  turn $data...}..
0e50: 7d 0a 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20  }..if {[llength 
0e60: 24 64 65 73 63 5d 20 3c 20 34 7d 20 7b 0a 09 20  $desc] < 4} {.. 
0e70: 20 20 20 73 65 74 20 6f 66 66 20 5b 65 78 70 72     set off [expr
0e80: 20 7b 28 24 69 6e 64 65 78 20 3c 3c 20 24 73 68   {($index << $sh
0e90: 69 66 74 29 20 3e 3e 20 33 7d 5d 0a 09 7d 20 65  ift) >> 3}]..} e
0ea0: 6c 73 65 20 7b 0a 09 20 20 20 20 23 20 64 6f 6e  lse {..    # don
0eb0: 27 74 20 6c 6f 61 64 20 6d 6f 72 65 20 74 68 61  't load more tha
0ec0: 6e 20 38 20 62 79 74 65 73 20 66 72 6f 6d 20 74  n 8 bytes from t
0ed0: 68 65 20 70 72 6f 70 65 72 20 6f 66 66 73 65 74  he proper offset
0ee0: 0a 09 20 20 20 20 69 6e 63 72 20 6f 66 66 20 5b  ..    incr off [
0ef0: 65 78 70 72 20 7b 28 24 69 6e 64 65 78 20 3c 3c  expr {($index <<
0f00: 20 24 73 68 69 66 74 29 20 3e 3e 20 33 7d 5d 0a   $shift) >> 3}].
0f10: 09 20 20 20 20 73 65 74 20 64 61 74 61 20 5b 6d  .    set data [m
0f20: 6d 61 70 20 24 64 61 74 61 20 24 6f 66 66 20 38  map $data $off 8
0f30: 5d 0a 09 20 20 20 20 73 65 74 20 6f 66 66 20 30  ]..    set off 0
0f40: 0a 09 7d 0a 09 73 77 69 74 63 68 20 2d 2d 20 24  ..}..switch -- $
0f50: 6d 6f 64 65 20 7b 0a 09 20 20 20 20 31 20 7b 0a  mode {..    1 {.
0f60: 09 09 20 20 20 20 62 69 6e 61 72 79 20 73 63 61  ..    binary sca
0f70: 6e 20 24 64 61 74 61 20 40 24 7b 6f 66 66 7d 63  n $data @${off}c
0f80: 20 76 61 6c 75 65 0a 09 09 20 20 20 20 72 65 74   value...    ret
0f90: 75 72 6e 20 5b 65 78 70 72 20 7b 28 24 76 61 6c  urn [expr {($val
0fa0: 75 65 3e 3e 28 24 69 6e 64 65 78 26 37 29 29 20  ue>>($index&7)) 
0fb0: 26 31 7d 5d 0a 09 09 7d 0a 09 20 20 20 20 32 20  &1}]...}..    2 
0fc0: 7b 0a 09 09 20 20 20 20 62 69 6e 61 72 79 20 73  {...    binary s
0fd0: 63 61 6e 20 24 64 61 74 61 20 40 24 7b 6f 66 66  can $data @${off
0fe0: 7d 63 20 76 61 6c 75 65 0a 09 09 20 20 20 20 72  }c value...    r
0ff0: 65 74 75 72 6e 20 5b 65 78 70 72 20 7b 28 24 76  eturn [expr {($v
1000: 61 6c 75 65 3e 3e 28 28 24 69 6e 64 65 78 26 33  alue>>(($index&3
1010: 29 20 3c 3c 31 29 29 20 26 33 7d 5d 0a 09 09 7d  ) <<1)) &3}]...}
1020: 0a 09 20 20 20 20 34 20 7b 0a 09 09 20 20 20 20  ..    4 {...    
1030: 62 69 6e 61 72 79 20 73 63 61 6e 20 24 64 61 74  binary scan $dat
1040: 61 20 40 24 7b 6f 66 66 7d 63 20 76 61 6c 75 65  a @${off}c value
1050: 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b 65  ...    return [e
1060: 78 70 72 20 7b 28 24 76 61 6c 75 65 3e 3e 28 28  xpr {($value>>((
1070: 24 69 6e 64 65 78 26 31 29 20 3c 3c 32 29 29 20  $index&1) <<2)) 
1080: 26 31 35 7d 5d 0a 09 09 7d 0a 09 20 20 20 20 38  &15}]...}..    8
1090: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20 31   {...    set w 1
10a0: 0a 09 09 20 20 20 20 73 65 74 20 66 20 63 0a 09  ...    set f c..
10b0: 09 7d 0a 09 20 20 20 20 31 36 20 7b 0a 09 09 20  .}..    16 {... 
10c0: 20 20 20 73 65 74 20 77 20 32 0a 09 09 20 20 20     set w 2...   
10d0: 20 73 65 74 20 66 20 73 0a 09 09 7d 0a 09 20 20   set f s...}..  
10e0: 20 20 31 36 72 20 7b 0a 09 09 20 20 20 20 73 65    16r {...    se
10f0: 74 20 77 20 32 0a 09 09 20 20 20 20 73 65 74 20  t w 2...    set 
1100: 66 20 53 0a 09 09 7d 0a 09 20 20 20 20 33 32 20  f S...}..    32 
1110: 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20 34 0a  {...    set w 4.
1120: 09 09 20 20 20 20 73 65 74 20 66 20 69 0a 09 09  ..    set f i...
1130: 7d 0a 09 20 20 20 20 33 32 72 20 7b 0a 09 09 20  }..    32r {... 
1140: 20 20 20 73 65 74 20 77 20 34 0a 09 09 20 20 20     set w 4...   
1150: 20 73 65 74 20 66 20 49 0a 09 09 7d 0a 09 20 20   set f I...}..  
1160: 20 20 33 32 66 72 20 2d 0a 09 20 20 20 20 33 32    32fr -..    32
1170: 66 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20  f {...    set w 
1180: 34 0a 09 09 20 20 20 20 73 65 74 20 66 20 66 0a  4...    set f f.
1190: 09 09 7d 0a 09 20 20 20 20 36 34 20 2d 0a 09 20  ..}..    64 -.. 
11a0: 20 20 20 36 34 72 20 7b 0a 09 09 20 20 20 20 73     64r {...    s
11b0: 65 74 20 77 20 38 0a 09 09 20 20 20 20 73 65 74  et w 8...    set
11c0: 20 66 20 69 32 0a 09 09 7d 0a 09 20 20 20 20 36   f i2...}..    6
11d0: 34 66 72 20 2d 0a 09 20 20 20 20 36 34 66 20 7b  4fr -..    64f {
11e0: 0a 09 09 20 20 20 20 73 65 74 20 77 20 38 0a 09  ...    set w 8..
11f0: 09 20 20 20 20 73 65 74 20 66 20 64 0a 09 09 7d  .    set f d...}
1200: 0a 09 7d 0a 0a 09 62 69 6e 61 72 79 20 73 63 61  ..}...binary sca
1210: 6e 20 24 64 61 74 61 20 40 24 6f 66 66 24 66 20  n $data @$off$f 
1220: 76 61 6c 75 65 0a 09 72 65 74 75 72 6e 20 24 76  value..return $v
1230: 61 6c 75 65 0a 20 20 20 20 7d 0a 0a 20 20 20 20  alue.    }..    
1240: 23 20 76 69 6d 3a 20 66 74 3d 74 63 6c 0a 0a 7d  # vim: ft=tcl..}
1250: 0a 0a 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d  ..if {[info comm
1260: 20 64 62 6f 70 65 6e 5d 20 3d 3d 20 22 22 7d 20   dbopen] == ""} 
1270: 7b 0a 20 20 20 20 23 20 44 65 63 6f 64 65 72 20  {.    # Decoder 
1280: 66 6f 72 20 4d 65 74 61 4b 69 74 20 64 61 74 61  for MetaKit data
1290: 66 69 6c 65 73 20 69 6e 20 54 63 6c 0a 0a 20 20  files in Tcl..  
12a0: 20 20 23 20 72 65 71 75 69 72 65 73 20 6d 6d 61    # requires mma
12b0: 70 2f 6d 76 65 63 20 70 72 69 6d 69 74 69 76 65  p/mvec primitive
12c0: 73 3a 0a 20 20 20 20 23 73 6f 75 72 63 65 20 5b  s:.    #source [
12d0: 66 69 6c 65 20 6a 6f 69 6e 20 5b 69 6e 66 6f 20  file join [info 
12e0: 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63  dirname [info sc
12f0: 72 69 70 74 5d 5d 20 6d 76 70 72 69 6d 2e 74 63  ript]] mvprim.tc
1300: 6c 5d 0a 0a 20 20 20 20 6e 61 6d 65 73 70 61 63  l]..    namespac
1310: 65 20 65 78 70 6f 72 74 20 64 62 6f 70 65 6e 20  e export dbopen 
1320: 64 62 63 6c 6f 73 65 20 64 62 74 72 65 65 20 61  dbclose dbtree a
1330: 63 63 65 73 73 20 76 6e 61 6d 65 73 20 76 6c 65  ccess vnames vle
1340: 6e 0a 0a 20 20 20 20 6e 61 6d 65 73 70 61 63 65  n..    namespace
1350: 20 65 76 61 6c 20 76 20 7b 0a 09 76 61 72 69 61   eval v {..varia
1360: 62 6c 65 20 77 69 64 74 68 73 20 7b 0a 20 20 20  ble widths {.   
1370: 20 7b 38 20 31 36 20 20 31 20 33 32 20 20 32 20   {8 16  1 32  2 
1380: 20 34 7d 0a 20 20 20 20 7b 34 20 20 38 20 20 31   4}.    {4  8  1
1390: 20 31 36 20 20 32 20 20 30 7d 0a 20 20 20 20 7b   16  2  0}.    {
13a0: 32 20 20 34 20 20 38 20 20 31 20 20 30 20 31 36  2  4  8  1  0 16
13b0: 7d 0a 20 20 20 20 7b 32 20 20 34 20 20 30 20 20  }.    {2  4  0  
13c0: 38 20 20 31 20 20 30 7d 0a 20 20 20 20 7b 31 20  8  1  0}.    {1 
13d0: 20 32 20 20 34 20 20 30 20 20 38 20 20 30 7d 0a   2  4  0  8  0}.
13e0: 20 20 20 20 7b 31 20 20 32 20 20 34 20 20 30 20      {1  2  4  0 
13f0: 20 30 20 20 38 7d 0a 20 20 20 20 7b 31 20 20 32   0  8}.    {1  2
1400: 20 20 30 20 20 34 20 20 30 20 20 30 7d 20 7d 0a    0  4  0  0} }.
1410: 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20      }..    proc 
1420: 66 65 74 63 68 20 7b 66 69 6c 65 7d 20 7b 0a 09  fetch {file} {..
1430: 69 66 20 7b 24 66 69 6c 65 20 3d 3d 20 22 22 7d  if {$file == ""}
1440: 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 74   {..    error "t
1450: 65 6d 70 20 73 74 6f 72 61 67 65 73 20 6e 6f 74  emp storages not
1460: 20 73 75 70 70 6f 72 74 65 64 22 0a 09 7d 0a 09   supported"..}..
1470: 73 65 74 20 76 3a 3a 64 61 74 61 20 5b 6f 70 65  set v::data [ope
1480: 6e 20 24 66 69 6c 65 5d 0a 09 73 65 74 20 76 3a  n $file]..set v:
1490: 3a 73 65 71 6e 20 30 0a 20 20 20 20 7d 0a 0a 20  :seqn 0.    }.. 
14a0: 20 20 20 70 72 6f 63 20 62 79 74 65 5f 73 65 67     proc byte_seg
14b0: 20 7b 6f 66 66 20 6c 65 6e 7d 20 7b 0a 09 69 6e   {off len} {..in
14c0: 63 72 20 6f 66 66 20 24 76 3a 3a 7a 65 72 6f 0a  cr off $v::zero.
14d0: 09 72 65 74 75 72 6e 20 5b 6d 6d 61 70 20 24 76  .return [mmap $v
14e0: 3a 3a 64 61 74 61 20 24 6f 66 66 20 24 6c 65 6e  ::data $off $len
14f0: 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f  ].    }..    pro
1500: 63 20 69 6e 74 5f 73 65 67 20 7b 6f 66 66 20 63  c int_seg {off c
1510: 6e 74 7d 20 7b 0a 09 73 65 74 20 76 65 63 20 5b  nt} {..set vec [
1520: 6c 69 73 74 20 33 32 72 20 5b 62 79 74 65 5f 73  list 32r [byte_s
1530: 65 67 20 24 6f 66 66 20 5b 65 78 70 72 20 7b 34  eg $off [expr {4
1540: 2a 24 63 6e 74 7d 5d 5d 5d 0a 09 72 65 74 75 72  *$cnt}]]]..retur
1550: 6e 20 5b 6d 76 65 63 20 24 76 65 63 20 30 20 24  n [mvec $vec 0 $
1560: 63 6e 74 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20  cnt].    }..    
1570: 70 72 6f 63 20 67 65 74 5f 73 20 7b 6c 65 6e 7d  proc get_s {len}
1580: 20 7b 0a 09 73 65 74 20 73 20 5b 62 79 74 65 5f   {..set s [byte_
1590: 73 65 67 20 24 76 3a 3a 63 75 72 72 20 24 6c 65  seg $v::curr $le
15a0: 6e 5d 0a 09 69 6e 63 72 20 76 3a 3a 63 75 72 72  n]..incr v::curr
15b0: 20 24 6c 65 6e 0a 09 72 65 74 75 72 6e 20 24 73   $len..return $s
15c0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63  .    }..    proc
15d0: 20 67 65 74 5f 76 20 7b 7d 20 7b 0a 09 73 65 74   get_v {} {..set
15e0: 20 76 20 30 0a 09 77 68 69 6c 65 20 31 20 7b 0a   v 0..while 1 {.
15f0: 09 20 20 20 20 73 65 74 20 63 68 61 72 20 5b 6d  .    set char [m
1600: 76 65 63 20 24 76 3a 3a 62 79 74 65 20 24 76 3a  vec $v::byte $v:
1610: 3a 63 75 72 72 5d 0a 09 20 20 20 20 69 6e 63 72  :curr]..    incr
1620: 20 76 3a 3a 63 75 72 72 0a 09 20 20 20 20 73 65   v::curr..    se
1630: 74 20 76 20 5b 65 78 70 72 20 7b 24 76 2a 31 32  t v [expr {$v*12
1640: 38 2b 28 24 63 68 61 72 26 30 78 66 66 29 7d 5d  8+($char&0xff)}]
1650: 0a 09 20 20 20 20 69 66 20 7b 24 63 68 61 72 20  ..    if {$char 
1660: 3c 20 30 7d 20 7b 0a 09 09 72 65 74 75 72 6e 20  < 0} {...return 
1670: 5b 69 6e 63 72 20 76 20 2d 31 32 38 5d 0a 09 20  [incr v -128].. 
1680: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20     }..}.    }.. 
1690: 20 20 20 70 72 6f 63 20 67 65 74 5f 70 20 7b 72     proc get_p {r
16a0: 6f 77 73 20 76 73 20 76 6f 7d 20 7b 0a 09 75 70  ows vs vo} {..up
16b0: 76 61 72 20 24 76 73 20 73 69 7a 65 20 24 76 6f  var $vs size $vo
16c0: 20 6f 66 66 0a 09 73 65 74 20 6f 66 66 20 30 0a   off..set off 0.
16d0: 09 69 66 20 7b 24 72 6f 77 73 20 3d 3d 20 30 7d  .if {$rows == 0}
16e0: 20 7b 0a 09 20 20 20 20 73 65 74 20 73 69 7a 65   {..    set size
16f0: 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20   0..} else {..  
1700: 20 20 73 65 74 20 73 69 7a 65 20 5b 67 65 74 5f    set size [get_
1710: 76 5d 0a 09 20 20 20 20 69 66 20 7b 24 73 69 7a  v]..    if {$siz
1720: 65 20 3e 20 30 7d 20 7b 0a 09 09 73 65 74 20 6f  e > 0} {...set o
1730: 66 66 20 5b 67 65 74 5f 76 5d 0a 09 20 20 20 20  ff [get_v]..    
1740: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20  }..}.    }..    
1750: 70 72 6f 63 20 68 65 61 64 65 72 20 7b 7b 65 6e  proc header {{en
1760: 64 20 22 22 7d 7d 20 7b 0a 09 73 65 74 20 76 3a  d ""}} {..set v:
1770: 3a 7a 65 72 6f 20 30 0a 09 69 66 20 7b 24 65 6e  :zero 0..if {$en
1780: 64 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20  d == ""} {..    
1790: 73 65 74 20 65 6e 64 20 5b 6d 6d 61 70 20 24 76  set end [mmap $v
17a0: 3a 3a 64 61 74 61 5d 0a 09 7d 0a 09 73 65 74 20  ::data]..}..set 
17b0: 76 3a 3a 62 79 74 65 20 5b 6c 69 73 74 20 38 20  v::byte [list 8 
17c0: 24 76 3a 3a 64 61 74 61 20 24 76 3a 3a 7a 65 72  $v::data $v::zer
17d0: 6f 20 24 65 6e 64 5d 0a 09 6c 61 73 73 69 67 6e  o $end]..lassign
17e0: 20 5b 69 6e 74 5f 73 65 67 20 5b 65 78 70 72 20   [int_seg [expr 
17f0: 7b 24 65 6e 64 2d 31 36 7d 5d 20 34 5d 20 74 31  {$end-16}] 4] t1
1800: 20 74 32 20 74 33 20 74 34 0a 09 73 65 74 20 76   t2 t3 t4..set v
1810: 3a 3a 7a 65 72 6f 20 5b 65 78 70 72 20 7b 24 65  ::zero [expr {$e
1820: 6e 64 2d 24 74 32 2d 31 36 7d 5d 0a 09 69 6e 63  nd-$t2-16}]..inc
1830: 72 20 65 6e 64 20 2d 24 76 3a 3a 7a 65 72 6f 0a  r end -$v::zero.
1840: 09 73 65 74 20 76 3a 3a 62 79 74 65 20 5b 6c 69  .set v::byte [li
1850: 73 74 20 38 20 24 76 3a 3a 64 61 74 61 20 24 76  st 8 $v::data $v
1860: 3a 3a 7a 65 72 6f 20 24 65 6e 64 5d 0a 09 6c 61  ::zero $end]..la
1870: 73 73 69 67 6e 20 5b 69 6e 74 5f 73 65 67 20 30  ssign [int_seg 0
1880: 20 32 5d 20 68 31 20 68 32 0a 09 6c 61 73 73 69   2] h1 h2..lassi
1890: 67 6e 20 5b 69 6e 74 5f 73 65 67 20 5b 65 78 70  gn [int_seg [exp
18a0: 72 20 7b 24 68 32 2d 38 7d 5d 20 32 5d 20 65 31  r {$h2-8}] 2] e1
18b0: 20 65 32 0a 09 73 65 74 20 76 3a 3a 69 6e 66 6f   e2..set v::info
18c0: 28 6d 6b 65 6e 64 29 20 24 68 32 0a 09 73 65 74  (mkend) $h2..set
18d0: 20 76 3a 3a 69 6e 66 6f 28 6d 6b 74 6f 63 29 20   v::info(mktoc) 
18e0: 24 65 32 0a 09 73 65 74 20 76 3a 3a 69 6e 66 6f  $e2..set v::info
18f0: 28 6d 6b 6c 65 6e 29 20 5b 65 78 70 72 20 7b 24  (mklen) [expr {$
1900: 65 31 20 26 20 30 78 66 66 66 66 66 66 7d 5d 0a  e1 & 0xffffff}].
1910: 09 73 65 74 20 76 3a 3a 63 75 72 72 20 24 65 32  .set v::curr $e2
1920: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63  .    }..    proc
1930: 20 6c 61 79 6f 75 74 20 7b 66 6d 74 7d 20 7b 0a   layout {fmt} {.
1940: 09 72 65 67 73 75 62 20 2d 61 6c 6c 20 7b 20 7d  .regsub -all { }
1950: 20 24 66 6d 74 20 22 22 20 66 6d 74 0a 09 72 65   $fmt "" fmt..re
1960: 67 73 75 62 20 2d 61 6c 6c 20 7b 28 5c 77 2b 29  gsub -all {(\w+)
1970: 5c 5b 7d 20 24 66 6d 74 20 22 7b 5c 5c 31 20 7b  \[} $fmt "{\\1 {
1980: 22 20 66 6d 74 0a 09 72 65 67 73 75 62 20 2d 61  " fmt..regsub -a
1990: 6c 6c 20 7b 5c 5d 7d 20 24 66 6d 74 20 22 7d 7d  ll {\]} $fmt "}}
19a0: 22 20 66 6d 74 0a 09 72 65 67 73 75 62 20 2d 61  " fmt..regsub -a
19b0: 6c 6c 20 7b 2c 7d 20 24 66 6d 74 20 22 20 22 20  ll {,} $fmt " " 
19c0: 66 6d 74 0a 09 72 65 74 75 72 6e 20 24 66 6d 74  fmt..return $fmt
19d0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63  .    }..    proc
19e0: 20 64 65 73 63 70 61 72 73 65 20 7b 64 65 73 63   descparse {desc
19f0: 7d 20 7b 0a 09 73 65 74 20 6e 61 6d 65 73 20 7b  } {..set names {
1a00: 7d 0a 09 73 65 74 20 74 79 70 65 73 20 7b 7d 0a  }..set types {}.
1a10: 09 66 6f 72 65 61 63 68 20 78 20 24 64 65 73 63  .foreach x $desc
1a20: 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 6c 6c 65   {..    if {[lle
1a30: 6e 67 74 68 20 24 78 5d 20 3d 3d 20 31 7d 20 7b  ngth $x] == 1} {
1a40: 0a 09 09 6c 61 73 73 69 67 6e 20 5b 73 70 6c 69  ...lassign [spli
1a50: 74 20 24 78 20 3a 5d 20 6e 61 6d 65 20 74 79 70  t $x :] name typ
1a60: 65 0a 09 09 69 66 20 7b 24 74 79 70 65 20 3d 3d  e...if {$type ==
1a70: 20 22 22 7d 20 7b 0a 09 09 20 20 20 20 73 65 74   ""} {...    set
1a80: 20 74 79 70 65 20 53 0a 09 09 7d 0a 09 20 20 20   type S...}..   
1a90: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 6c 61 73 73   } else {...lass
1aa0: 69 67 6e 20 24 78 20 6e 61 6d 65 20 74 79 70 65  ign $x name type
1ab0: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 6c 61 70  ..    }..    lap
1ac0: 70 65 6e 64 20 6e 61 6d 65 73 20 24 6e 61 6d 65  pend names $name
1ad0: 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 20 74 79  ..    lappend ty
1ae0: 70 65 73 20 24 74 79 70 65 0a 09 7d 0a 09 72 65  pes $type..}..re
1af0: 74 75 72 6e 20 5b 6c 69 73 74 20 24 6e 61 6d 65  turn [list $name
1b00: 73 20 24 74 79 70 65 73 5d 0a 20 20 20 20 7d 0a  s $types].    }.
1b10: 0a 20 20 20 20 70 72 6f 63 20 6e 75 6d 76 65 63  .    proc numvec
1b20: 20 7b 72 6f 77 73 20 74 79 70 65 7d 20 7b 0a 09   {rows type} {..
1b30: 67 65 74 5f 70 20 24 72 6f 77 73 20 73 69 7a 65  get_p $rows size
1b40: 20 6f 66 66 0a 09 69 66 20 7b 24 73 69 7a 65 20   off..if {$size 
1b50: 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 72 65 74  == 0} {..    ret
1b60: 75 72 6e 20 7b 30 20 30 7d 0a 09 7d 0a 09 73 65  urn {0 0}..}..se
1b70: 74 20 77 20 5b 65 78 70 72 20 7b 69 6e 74 28 28  t w [expr {int((
1b80: 24 73 69 7a 65 3c 3c 33 29 20 2f 24 72 6f 77 73  $size<<3) /$rows
1b90: 29 7d 5d 0a 09 69 66 20 7b 24 72 6f 77 73 20 3c  )}]..if {$rows <
1ba0: 3d 20 37 20 26 26 20 30 20 3c 20 24 73 69 7a 65  = 7 && 0 < $size
1bb0: 20 26 26 20 24 73 69 7a 65 20 3c 3d 20 36 7d 20   && $size <= 6} 
1bc0: 7b 0a 09 20 20 20 20 73 65 74 20 77 20 5b 6c 69  {..    set w [li
1bd0: 6e 64 65 78 20 5b 6c 69 6e 64 65 78 20 24 76 3a  ndex [lindex $v:
1be0: 3a 77 69 64 74 68 73 20 5b 65 78 70 72 20 7b 24  :widths [expr {$
1bf0: 72 6f 77 73 2d 31 7d 5d 5d 20 5b 65 78 70 72 20  rows-1}]] [expr 
1c00: 7b 24 73 69 7a 65 2d 31 7d 5d 5d 0a 09 7d 0a 09  {$size-1}]]..}..
1c10: 69 66 20 7b 24 77 20 3d 3d 20 30 7d 20 7b 0a 09  if {$w == 0} {..
1c20: 20 20 20 20 65 72 72 6f 72 20 22 6e 75 6d 76 65      error "numve
1c30: 63 3f 22 0a 09 7d 0a 09 73 77 69 74 63 68 20 24  c?"..}..switch $
1c40: 74 79 70 65 5c 0a 09 20 20 20 20 20 20 46 20 7b  type\..      F {
1c50: 0a 09 09 20 20 20 20 73 65 74 20 77 20 33 32 66  ...    set w 32f
1c60: 0a 09 09 7d 5c 0a 09 20 20 20 20 20 20 44 20 7b  ...}\..      D {
1c70: 0a 09 09 20 20 20 20 73 65 74 20 77 20 36 34 66  ...    set w 64f
1c80: 0a 09 09 7d 0a 09 69 6e 63 72 20 6f 66 66 20 24  ...}..incr off $
1c90: 76 3a 3a 7a 65 72 6f 0a 09 72 65 74 75 72 6e 20  v::zero..return 
1ca0: 5b 6c 69 73 74 20 24 77 20 24 76 3a 3a 64 61 74  [list $w $v::dat
1cb0: 61 20 24 6f 66 66 20 24 72 6f 77 73 5d 0a 20 20  a $off $rows].  
1cc0: 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6c 61    }..    proc la
1cd0: 7a 79 5f 73 74 72 20 7b 73 65 6c 66 20 72 6f 77  zy_str {self row
1ce0: 73 20 74 79 70 65 20 70 6f 73 20 73 69 7a 65 73  s type pos sizes
1cf0: 20 6d 73 69 7a 65 20 6d 6f 66 66 20 69 6e 64 65   msize moff inde
1d00: 78 7d 20 7b 0a 09 73 65 74 20 73 6f 66 66 20 7b  x} {..set soff {
1d10: 7d 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 7d  }..for {set i 0}
1d20: 20 7b 24 69 20 3c 20 24 72 6f 77 73 7d 20 7b 69   {$i < $rows} {i
1d30: 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 73 65  ncr i} {..    se
1d40: 74 20 6e 20 5b 6d 76 65 63 20 24 73 69 7a 65 73  t n [mvec $sizes
1d50: 20 24 69 5d 0a 09 20 20 20 20 6c 61 70 70 65 6e   $i]..    lappen
1d60: 64 20 73 6f 66 66 20 24 70 6f 73 0a 09 20 20 20  d soff $pos..   
1d70: 20 69 6e 63 72 20 70 6f 73 20 24 6e 0a 09 7d 0a   incr pos $n..}.
1d80: 09 69 66 20 7b 24 6d 73 69 7a 65 20 3e 20 30 7d  .if {$msize > 0}
1d90: 20 7b 0a 09 20 20 20 20 73 65 74 20 73 6c 65 6e   {..    set slen
1da0: 20 5b 6d 76 65 63 20 24 73 69 7a 65 73 20 30 20   [mvec $sizes 0 
1db0: 24 72 6f 77 73 5d 0a 09 20 20 20 20 73 65 74 20  $rows]..    set 
1dc0: 76 3a 3a 63 75 72 72 20 24 6d 6f 66 66 0a 09 20  v::curr $moff.. 
1dd0: 20 20 20 73 65 74 20 6c 69 6d 69 74 20 5b 65 78     set limit [ex
1de0: 70 72 20 7b 24 6d 6f 66 66 2b 24 6d 73 69 7a 65  pr {$moff+$msize
1df0: 7d 5d 0a 09 20 20 20 20 66 6f 72 20 7b 73 65 74  }]..    for {set
1e00: 20 72 6f 77 20 30 7d 20 7b 24 76 3a 3a 63 75 72   row 0} {$v::cur
1e10: 72 20 3c 20 24 6c 69 6d 69 74 7d 20 7b 69 6e 63  r < $limit} {inc
1e20: 72 20 72 6f 77 7d 20 7b 0a 09 09 69 6e 63 72 20  r row} {...incr 
1e30: 72 6f 77 20 5b 67 65 74 5f 76 5d 0a 09 09 67 65  row [get_v]...ge
1e40: 74 5f 70 20 31 20 6d 73 20 6d 6f 0a 09 09 73 65  t_p 1 ms mo...se
1e50: 74 20 73 6f 66 66 20 5b 6c 72 65 70 6c 61 63 65  t soff [lreplace
1e60: 20 24 73 6f 66 66 20 24 72 6f 77 20 24 72 6f 77   $soff $row $row
1e70: 20 24 6d 6f 5d 0a 09 09 73 65 74 20 73 6c 65 6e   $mo]...set slen
1e80: 20 5b 6c 72 65 70 6c 61 63 65 20 24 73 6c 65 6e   [lreplace $slen
1e90: 20 24 72 6f 77 20 24 72 6f 77 20 24 6d 73 5d 0a   $row $row $ms].
1ea0: 09 20 20 20 20 7d 0a 09 20 20 20 20 73 65 74 20  .    }..    set 
1eb0: 73 69 7a 65 73 20 5b 6c 69 73 74 20 6c 69 6e 64  sizes [list lind
1ec0: 65 78 20 24 73 6c 65 6e 20 24 72 6f 77 73 5d 0a  ex $slen $rows].
1ed0: 09 7d 0a 09 69 66 20 7b 24 74 79 70 65 20 3d 3d  .}..if {$type ==
1ee0: 20 22 53 22 7d 20 7b 0a 09 20 20 20 20 73 65 74   "S"} {..    set
1ef0: 20 61 64 6a 20 2d 31 0a 09 7d 20 65 6c 73 65 20   adj -1..} else 
1f00: 7b 0a 09 20 20 20 20 73 65 74 20 61 64 6a 20 30  {..    set adj 0
1f10: 0a 09 7d 0a 09 73 65 74 20 76 3a 3a 6e 6f 64 65  ..}..set v::node
1f20: 28 24 73 65 6c 66 29 20 5b 6c 69 73 74 20 67 65  ($self) [list ge
1f30: 74 5f 73 74 72 20 24 73 6f 66 66 20 24 73 69 7a  t_str $soff $siz
1f40: 65 73 20 24 61 64 6a 20 24 72 6f 77 73 5d 0a 09  es $adj $rows]..
1f50: 72 65 74 75 72 6e 20 5b 6d 76 65 63 20 24 76 3a  return [mvec $v:
1f60: 3a 6e 6f 64 65 28 24 73 65 6c 66 29 20 24 69 6e  :node($self) $in
1f70: 64 65 78 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20  dex].    }..    
1f80: 70 72 6f 63 20 67 65 74 5f 73 74 72 20 7b 73 6f  proc get_str {so
1f90: 66 66 20 73 69 7a 65 73 20 61 64 6a 20 69 6e 64  ff sizes adj ind
1fa0: 65 78 7d 20 7b 0a 09 73 65 74 20 6e 20 5b 6d 76  ex} {..set n [mv
1fb0: 65 63 20 24 73 69 7a 65 73 20 24 69 6e 64 65 78  ec $sizes $index
1fc0: 5d 0a 09 72 65 74 75 72 6e 20 5b 62 79 74 65 5f  ]..return [byte_
1fd0: 73 65 67 20 5b 6c 69 6e 64 65 78 20 24 73 6f 66  seg [lindex $sof
1fe0: 66 20 24 69 6e 64 65 78 5d 20 5b 69 6e 63 72 20  f $index] [incr 
1ff0: 6e 20 24 61 64 6a 5d 5d 0a 20 20 20 20 7d 0a 0a  n $adj]].    }..
2000: 20 20 20 20 70 72 6f 63 20 6c 61 7a 79 5f 73 75      proc lazy_su
2010: 62 20 7b 73 65 6c 66 20 64 65 73 63 20 73 69 7a  b {self desc siz
2020: 65 20 6f 66 66 20 72 6f 77 73 20 69 6e 64 65 78  e off rows index
2030: 7d 20 7b 0a 09 73 65 74 20 76 3a 3a 63 75 72 72  } {..set v::curr
2040: 20 24 6f 66 66 0a 09 6c 61 73 73 69 67 6e 20 5b   $off..lassign [
2050: 64 65 73 63 70 61 72 73 65 20 24 64 65 73 63 5d  descparse $desc]
2060: 20 6e 61 6d 65 73 20 74 79 70 65 73 0a 09 73 65   names types..se
2070: 74 20 73 75 62 73 20 7b 7d 0a 09 66 6f 72 20 7b  t subs {}..for {
2080: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 24  set i 0} {$i < $
2090: 72 6f 77 73 7d 20 7b 69 6e 63 72 20 69 7d 20 7b  rows} {incr i} {
20a0: 0a 09 20 20 20 20 69 66 20 7b 5b 67 65 74 5f 76  ..    if {[get_v
20b0: 5d 20 21 3d 20 30 7d 20 7b 0a 09 09 65 72 72 6f  ] != 0} {...erro
20c0: 72 20 22 6c 61 7a 79 5f 73 75 62 3f 22 0a 09 20  r "lazy_sub?".. 
20d0: 20 20 20 7d 0a 09 20 20 20 20 6c 61 70 70 65 6e     }..    lappen
20e0: 64 20 73 75 62 73 20 5b 70 72 65 70 61 72 65 20  d subs [prepare 
20f0: 24 74 79 70 65 73 5d 0a 09 7d 0a 09 73 65 74 20  $types]..}..set 
2100: 76 3a 3a 6e 6f 64 65 28 24 73 65 6c 66 29 20 5b  v::node($self) [
2110: 6c 69 73 74 20 67 65 74 5f 73 75 62 20 24 6e 61  list get_sub $na
2120: 6d 65 73 20 24 73 75 62 73 20 24 72 6f 77 73 5d  mes $subs $rows]
2130: 0a 09 72 65 74 75 72 6e 20 5b 6d 76 65 63 20 24  ..return [mvec $
2140: 76 3a 3a 6e 6f 64 65 28 24 73 65 6c 66 29 20 24  v::node($self) $
2150: 69 6e 64 65 78 5d 0a 20 20 20 20 7d 0a 0a 23 70  index].    }..#p
2160: 72 6f 63 20 62 61 63 6b 74 72 61 63 65 20 7b 7b  roc backtrace {{
2170: 6c 65 76 65 6c 5f 61 64 6a 20 30 7d 7d 20 7b 0a  level_adj 0}} {.
2180: 23 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  #               
2190: 20 20 20 20 20 20 20 20 20 73 65 74 20 72 65 74           set ret
21a0: 20 5b 6c 69 73 74 5d 20 20 20 20 20 20 20 20 20   [list]         
21b0: 20 0a 23 0a 23 20 20 20 20 20 20 20 20 20 20 20   .#.#           
21c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74               set
21d0: 20 6c 65 76 65 6c 20 5b 65 78 70 72 20 30 20 2d   level [expr 0 -
21e0: 20 24 6c 65 76 65 6c 5f 61 64 6a 5d 0a 23 20 20   $level_adj].#  
21f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2200: 20 20 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69        for {set i
2210: 20 5b 65 78 70 72 20 5b 69 6e 66 6f 20 6c 65 76   [expr [info lev
2220: 65 6c 5d 20 2d 20 24 6c 65 76 65 6c 5f 61 64 6a  el] - $level_adj
2230: 5d 7d 20 7b 24 69 20 3e 20 31 7d 20 7b 69 6e 63  ]} {$i > 1} {inc
2240: 72 20 69 20 2d 31 7d 20 7b 0a 23 20 20 20 20 20  r i -1} {.#     
2250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2260: 20 20 20 20 20 20 20 20 20 20 20 69 6e 63 72 20             incr 
2270: 6c 65 76 65 6c 20 2d 31 0a 23 20 20 20 20 20 20  level -1.#      
2280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2290: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 72 65            set re
22a0: 74 20 5b 6c 69 6e 73 65 72 74 20 24 72 65 74 20  t [linsert $ret 
22b0: 30 20 5b 6c 69 6e 64 65 78 20 5b 69 6e 66 6f 20  0 [lindex [info 
22c0: 6c 65 76 65 6c 20 24 6c 65 76 65 6c 5d 20 30 5d  level $level] 0]
22d0: 5d 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 20  ].#             
22e0: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 23 20 20             }.#  
22f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2300: 20 20 20 20 20 20 73 65 74 20 72 65 74 20 5b 6c        set ret [l
2310: 69 6e 73 65 72 74 20 24 72 65 74 20 30 20 47 4c  insert $ret 0 GL
2320: 4f 42 41 4c 5d 0a 23 20 20 20 20 20 20 20 20 0a  OBAL].#        .
2330: 23 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  #               
2340: 20 20 20 20 20 20 20 20 20 72 65 74 75 72 6e 20           return 
2350: 24 72 65 74 0a 23 7d 0a 0a 20 20 20 20 70 72 6f  $ret.#}..    pro
2360: 63 20 67 65 74 5f 73 75 62 20 7b 6e 61 6d 65 73  c get_sub {names
2370: 20 73 75 62 73 20 69 6e 64 65 78 7d 20 7b 0a 23   subs index} {.#
2380: 70 75 74 73 20 73 74 64 65 72 72 20 22 44 45 42  puts stderr "DEB
2390: 55 47 3a 20 67 65 74 5f 73 75 62 3a 20 5b 6c 69  UG: get_sub: [li
23a0: 73 74 20 24 6e 61 6d 65 73 20 24 73 75 62 73 20  st $names $subs 
23b0: 24 69 6e 64 65 78 5d 22 0a 23 70 75 74 73 20 22  $index]".#puts "
23c0: 62 61 63 6b 74 72 61 63 65 3a 20 5b 62 61 63 6b  backtrace: [back
23d0: 74 72 61 63 65 5d 22 0a 09 6c 61 73 73 69 67 6e  trace]"..lassign
23e0: 20 5b 6c 69 6e 64 65 78 20 24 73 75 62 73 20 24   [lindex $subs $
23f0: 69 6e 64 65 78 5d 20 72 6f 77 73 20 68 61 6e 64  index] rows hand
2400: 6c 65 72 73 0a 09 72 65 74 75 72 6e 20 5b 6c 69  lers..return [li
2410: 73 74 20 67 65 74 5f 76 69 65 77 20 24 6e 61 6d  st get_view $nam
2420: 65 73 20 24 72 6f 77 73 20 24 68 61 6e 64 6c 65  es $rows $handle
2430: 72 73 20 24 72 6f 77 73 5d 0a 20 20 20 20 7d 0a  rs $rows].    }.
2440: 0a 20 20 20 20 70 72 6f 63 20 70 72 65 70 61 72  .    proc prepar
2450: 65 20 7b 74 79 70 65 73 7d 20 7b 0a 09 73 65 74  e {types} {..set
2460: 20 72 20 5b 67 65 74 5f 76 5d 0a 09 73 65 74 20   r [get_v]..set 
2470: 68 61 6e 64 6c 65 72 73 20 7b 7d 0a 09 66 6f 72  handlers {}..for
2480: 65 61 63 68 20 78 20 24 74 79 70 65 73 20 7b 0a  each x $types {.
2490: 09 20 20 20 20 73 65 74 20 6e 20 5b 69 6e 63 72  .    set n [incr
24a0: 20 76 3a 3a 73 65 71 6e 5d 0a 09 20 20 20 20 6c   v::seqn]..    l
24b0: 61 70 70 65 6e 64 20 68 61 6e 64 6c 65 72 73 20  append handlers 
24c0: 24 6e 0a 09 20 20 20 20 73 77 69 74 63 68 20 24  $n..    switch $
24d0: 78 20 7b 0a 09 09 49 20 2d 0a 09 09 4c 20 2d 0a  x {...I -...L -.
24e0: 09 09 46 20 2d 0a 09 09 44 20 7b 0a 09 09 09 73  ..F -...D {....s
24f0: 65 74 20 76 3a 3a 6e 6f 64 65 28 24 6e 29 20 5b  et v::node($n) [
2500: 6e 75 6d 76 65 63 20 24 72 20 24 78 5d 0a 09 09  numvec $r $x]...
2510: 20 20 20 20 7d 0a 09 09 42 20 2d 0a 09 09 53 20      }...B -...S 
2520: 7b 0a 09 09 09 67 65 74 5f 70 20 24 72 20 73 69  {....get_p $r si
2530: 7a 65 20 6f 66 66 0a 09 09 09 73 65 74 20 73 69  ze off....set si
2540: 7a 65 73 20 7b 30 20 30 7d 0a 09 09 09 69 66 20  zes {0 0}....if 
2550: 7b 24 73 69 7a 65 20 3e 20 30 7d 20 7b 0a 09 09  {$size > 0} {...
2560: 09 20 20 20 20 73 65 74 20 73 69 7a 65 73 20 5b  .    set sizes [
2570: 6e 75 6d 76 65 63 20 24 72 20 49 5d 0a 09 09 09  numvec $r I]....
2580: 7d 0a 09 09 09 67 65 74 5f 70 20 24 72 20 6d 73  }....get_p $r ms
2590: 69 7a 65 20 6d 6f 66 66 0a 09 09 09 73 65 74 20  ize moff....set 
25a0: 76 3a 3a 6e 6f 64 65 28 24 6e 29 20 5b 6c 69 73  v::node($n) [lis
25b0: 74 20 6c 61 7a 79 5f 73 74 72 20 24 6e 20 24 72  t lazy_str $n $r
25c0: 20 24 78 20 24 6f 66 66 20 24 73 69 7a 65 73 5c   $x $off $sizes\
25d0: 0a 09 09 09 20 20 24 6d 73 69 7a 65 20 24 6d 6f  ....  $msize $mo
25e0: 66 66 20 24 72 5d 0a 09 09 20 20 20 20 7d 0a 09  ff $r]...    }..
25f0: 09 64 65 66 61 75 6c 74 20 7b 0a 09 09 09 67 65  .default {....ge
2600: 74 5f 70 20 24 72 20 73 69 7a 65 20 6f 66 66 0a  t_p $r size off.
2610: 09 09 09 73 65 74 20 76 3a 3a 6e 6f 64 65 28 24  ...set v::node($
2620: 6e 29 20 5b 6c 69 73 74 20 6c 61 7a 79 5f 73 75  n) [list lazy_su
2630: 62 20 24 6e 20 24 78 20 24 73 69 7a 65 20 24 6f  b $n $x $size $o
2640: 66 66 20 24 72 20 24 72 5d 0a 09 09 20 20 20 20  ff $r $r]...    
2650: 7d 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 72 65 74  }..    }..}..ret
2660: 75 72 6e 20 5b 6c 69 73 74 20 24 72 20 24 68 61  urn [list $r $ha
2670: 6e 64 6c 65 72 73 5d 0a 20 20 20 20 7d 0a 0a 20  ndlers].    }.. 
2680: 20 20 20 70 72 6f 63 20 67 65 74 5f 76 69 65 77     proc get_view
2690: 20 7b 6e 61 6d 65 73 20 72 6f 77 73 20 68 61 6e   {names rows han
26a0: 64 6c 65 72 73 20 69 6e 64 65 78 7d 20 7b 0a 09  dlers index} {..
26b0: 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 67 65 74  return [list get
26c0: 5f 70 72 6f 70 20 24 6e 61 6d 65 73 20 24 72 6f  _prop $names $ro
26d0: 77 73 20 24 68 61 6e 64 6c 65 72 73 20 24 69 6e  ws $handlers $in
26e0: 64 65 78 20 5b 6c 6c 65 6e 67 74 68 20 24 6e 61  dex [llength $na
26f0: 6d 65 73 5d 5d 0a 20 20 20 20 7d 0a 0a 20 20 20  mes]].    }..   
2700: 20 70 72 6f 63 20 67 65 74 5f 70 72 6f 70 20 7b   proc get_prop {
2710: 6e 61 6d 65 73 20 72 6f 77 73 20 68 61 6e 64 6c  names rows handl
2720: 65 72 73 20 69 6e 64 65 78 20 69 64 65 6e 74 7d  ers index ident}
2730: 20 7b 0a 09 73 65 74 20 63 6f 6c 20 5b 6c 73 65   {..set col [lse
2740: 61 72 63 68 20 2d 65 78 61 63 74 20 24 6e 61 6d  arch -exact $nam
2750: 65 73 20 24 69 64 65 6e 74 5d 0a 09 69 66 20 7b  es $ident]..if {
2760: 24 63 6f 6c 20 3c 20 30 7d 20 7b 0a 09 20 20 20  $col < 0} {..   
2770: 20 65 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20   error "unknown 
2780: 70 72 6f 70 65 72 74 79 3a 20 24 69 64 65 6e 74  property: $ident
2790: 22 0a 09 7d 0a 09 73 65 74 20 68 20 5b 6c 69 6e  "..}..set h [lin
27a0: 64 65 78 20 24 68 61 6e 64 6c 65 72 73 20 24 63  dex $handlers $c
27b0: 6f 6c 5d 0a 09 73 65 74 20 72 65 74 20 5b 6d 76  ol]..set ret [mv
27c0: 65 63 20 24 76 3a 3a 6e 6f 64 65 28 24 68 29 20  ec $v::node($h) 
27d0: 24 69 6e 64 65 78 5d 0a 0a 09 72 65 74 75 72 6e  $index]...return
27e0: 20 24 72 65 74 0a 20 20 20 20 7d 0a 0a 20 20 20   $ret.    }..   
27f0: 20 70 72 6f 63 20 64 62 6f 70 65 6e 20 7b 64 62   proc dbopen {db
2800: 20 66 69 6c 65 7d 20 7b 0a 09 23 20 6f 70 65 6e   file} {..# open
2810: 20 64 61 74 61 66 69 6c 65 2c 20 73 74 6f 72 65   datafile, store
2820: 73 20 64 61 74 61 66 69 6c 65 20 64 65 73 63 72  s datafile descr
2830: 69 70 74 6f 72 73 20 61 6e 64 20 73 74 61 72 74  iptors and start
2840: 73 20 62 75 69 6c 64 69 6e 67 20 74 72 65 65 0a  s building tree.
2850: 09 69 66 20 7b 24 64 62 20 3d 3d 20 22 22 7d 20  .if {$db == ""} 
2860: 7b 0a 09 20 20 20 20 73 65 74 20 72 20 7b 7d 0a  {..    set r {}.
2870: 09 20 20 20 20 66 6f 72 65 61 63 68 20 7b 6b 20  .    foreach {k 
2880: 76 7d 20 5b 61 72 72 61 79 20 67 65 74 20 76 3a  v} [array get v:
2890: 3a 64 62 73 5d 20 7b 0a 09 09 6c 61 70 70 65 6e  :dbs] {...lappen
28a0: 64 20 72 20 24 6b 20 5b 6c 69 6e 64 65 78 20 24  d r $k [lindex $
28b0: 76 20 30 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20  v 0]..    }..   
28c0: 20 72 65 74 75 72 6e 20 24 72 0a 09 7d 0a 09 66   return $r..}..f
28d0: 65 74 63 68 20 24 66 69 6c 65 0a 09 68 65 61 64  etch $file..head
28e0: 65 72 0a 09 69 66 20 7b 5b 67 65 74 5f 76 5d 20  er..if {[get_v] 
28f0: 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 65 72 72  != 0} {..    err
2900: 6f 72 20 22 64 62 6f 70 65 6e 3f 22 0a 09 7d 0a  or "dbopen?"..}.
2910: 09 73 65 74 20 64 65 73 63 20 5b 6c 61 79 6f 75  .set desc [layou
2920: 74 20 5b 67 65 74 5f 73 20 5b 67 65 74 5f 76 5d  t [get_s [get_v]
2930: 5d 5d 0a 09 6c 61 73 73 69 67 6e 20 5b 64 65 73  ]]..lassign [des
2940: 63 70 61 72 73 65 20 24 64 65 73 63 5d 20 6e 61  cparse $desc] na
2950: 6d 65 73 20 74 79 70 65 73 0a 09 73 65 74 20 72  mes types..set r
2960: 6f 6f 74 20 5b 67 65 74 5f 73 75 62 20 24 6e 61  oot [get_sub $na
2970: 6d 65 73 20 5b 6c 69 73 74 20 5b 70 72 65 70 61  mes [list [prepa
2980: 72 65 20 24 74 79 70 65 73 5d 5d 20 30 5d 0a 09  re $types]] 0]..
2990: 73 65 74 20 76 3a 3a 64 62 73 28 24 64 62 29 20  set v::dbs($db) 
29a0: 5b 6c 69 73 74 20 24 66 69 6c 65 20 24 76 3a 3a  [list $file $v::
29b0: 64 61 74 61 20 24 64 65 73 63 20 5b 6d 76 65 63  data $desc [mvec
29c0: 20 24 72 6f 6f 74 20 30 5d 5d 0a 09 72 65 74 75   $root 0]]..retu
29d0: 72 6e 20 24 64 62 0a 20 20 20 20 7d 0a 0a 20 20  rn $db.    }..  
29e0: 20 20 70 72 6f 63 20 64 62 63 6c 6f 73 65 20 7b    proc dbclose {
29f0: 64 62 7d 20 7b 0a 09 23 20 63 6c 6f 73 65 20 64  db} {..# close d
2a00: 61 74 61 66 69 6c 65 2c 20 67 65 74 20 72 69 64  atafile, get rid
2a10: 20 6f 66 20 73 74 6f 72 65 64 20 69 6e 66 6f 0a   of stored info.
2a20: 09 75 6e 73 65 74 20 76 3a 3a 64 62 73 28 24 64  .unset v::dbs($d
2a30: 62 29 0a 09 73 65 74 20 76 3a 3a 64 61 74 61 20  b)..set v::data 
2a40: 22 22 20 3b 23 20 69 74 20 6d 61 79 20 62 65 20  "" ;# it may be 
2a50: 62 69 67 20 0a 20 20 20 20 7d 0a 0a 20 20 20 20  big .    }..    
2a60: 70 72 6f 63 20 64 62 74 72 65 65 20 7b 64 62 7d  proc dbtree {db}
2a70: 20 7b 0a 09 23 20 64 61 74 61 66 69 6c 65 20 73   {..# datafile s
2a80: 65 6c 65 63 74 69 6f 6e 2c 20 66 69 72 73 74 20  election, first 
2a90: 73 74 65 70 20 69 6e 20 61 63 63 65 73 73 20 6e  step in access n
2aa0: 61 76 69 67 61 74 69 6f 6e 20 6c 6f 6f 70 0a 09  avigation loop..
2ab0: 72 65 74 75 72 6e 20 5b 6c 69 6e 64 65 78 20 24  return [lindex $
2ac0: 76 3a 3a 64 62 73 28 24 64 62 29 20 33 5d 0a 20  v::dbs($db) 3]. 
2ad0: 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 61     }..    proc a
2ae0: 63 63 65 73 73 20 7b 73 70 65 63 7d 20 7b 0a 09  ccess {spec} {..
2af0: 23 20 74 68 69 73 20 69 73 20 74 68 65 20 6d 61  # this is the ma
2b00: 69 6e 20 61 63 63 65 73 73 20 6e 61 76 69 67 61  in access naviga
2b10: 74 69 6f 6e 20 6c 6f 6f 70 0a 09 73 65 74 20 73  tion loop..set s
2b20: 20 5b 73 70 6c 69 74 20 24 73 70 65 63 20 22 2e   [split $spec ".
2b30: 21 22 5d 0a 09 73 65 74 20 78 20 5b 6c 69 73 74  !"]..set x [list
2b40: 20 64 62 74 72 65 65 20 5b 61 72 72 61 79 20 73   dbtree [array s
2b50: 69 7a 65 20 76 3a 3a 64 62 73 5d 5d 0a 09 66 6f  ize v::dbs]]..fo
2b60: 72 65 61 63 68 20 79 20 24 73 20 7b 0a 09 20 20  reach y $s {..  
2b70: 20 20 73 65 74 20 78 20 5b 6d 76 65 63 20 24 78    set x [mvec $x
2b80: 20 24 79 5d 0a 09 7d 0a 09 72 65 74 75 72 6e 20   $y]..}..return 
2b90: 24 78 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72  $x.    }..    pr
2ba0: 6f 63 20 76 6e 61 6d 65 73 20 7b 76 69 65 77 7d  oc vnames {view}
2bb0: 20 7b 0a 09 23 20 72 65 74 75 72 6e 20 61 20 6c   {..# return a l
2bc0: 69 73 74 20 6f 66 20 70 72 6f 70 65 72 74 79 20  ist of property 
2bd0: 6e 61 6d 65 73 0a 09 69 66 20 7b 5b 6c 69 6e 64  names..if {[lind
2be0: 65 78 20 24 76 69 65 77 20 30 5d 20 21 3d 20 22  ex $view 0] != "
2bf0: 67 65 74 5f 76 69 65 77 22 7d 20 7b 0a 09 20 20  get_view"} {..  
2c00: 20 20 65 72 72 6f 72 20 22 76 6e 61 6d 65 73 3f    error "vnames?
2c10: 22 0a 09 7d 0a 09 72 65 74 75 72 6e 20 5b 6c 69  "..}..return [li
2c20: 6e 64 65 78 20 24 76 69 65 77 20 31 5d 0a 20 20  ndex $view 1].  
2c30: 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 76 6c    }..    proc vl
2c40: 65 6e 20 7b 76 69 65 77 7d 20 7b 0a 09 23 20 72  en {view} {..# r
2c50: 65 74 75 72 6e 20 74 68 65 20 6e 75 6d 62 65 72  eturn the number
2c60: 20 6f 66 20 72 6f 77 73 20 69 6e 20 74 68 69 73   of rows in this
2c70: 20 76 69 65 77 0a 09 69 66 20 7b 5b 6c 69 6e 64   view..if {[lind
2c80: 65 78 20 24 76 69 65 77 20 30 5d 20 21 3d 20 22  ex $view 0] != "
2c90: 67 65 74 5f 76 69 65 77 22 7d 20 7b 0a 09 20 20  get_view"} {..  
2ca0: 20 20 65 72 72 6f 72 20 22 76 6c 65 6e 3f 22 0a    error "vlen?".
2cb0: 09 7d 0a 09 72 65 74 75 72 6e 20 5b 6c 69 6e 64  .}..return [lind
2cc0: 65 78 20 24 76 69 65 77 20 32 5d 0a 20 20 20 20  ex $view 2].    
2cd0: 7d 0a 0a 20 20 20 20 23 20 76 69 6d 3a 20 66 74  }..    # vim: ft
2ce0: 3d 74 63 6c 0a 0a 7d 0a 0a 69 66 20 7b 5b 69 6e  =tcl..}..if {[in
2cf0: 66 6f 20 63 6f 6d 6d 20 6d 6b 5f 66 69 6c 65 5d  fo comm mk_file]
2d00: 20 3d 3d 20 22 22 7d 20 7b 0a 20 20 20 20 23 20   == ""} {.    # 
2d10: 43 6f 6d 70 61 74 69 62 69 6c 69 74 79 20 6c 61  Compatibility la
2d20: 79 65 72 20 66 6f 72 20 4d 65 74 61 4b 69 74 0a  yer for MetaKit.
2d30: 0a 20 20 20 20 23 20 72 65 71 75 69 72 65 73 20  .    # requires 
2d40: 64 62 6f 70 65 6e 2f 64 62 63 6c 6f 73 65 2f 64  dbopen/dbclose/d
2d50: 62 74 72 65 65 2f 61 63 63 65 73 73 2f 76 6e 61  btree/access/vna
2d60: 6d 65 73 2f 76 6c 65 6e 2f 6d 76 65 63 20 70 72  mes/vlen/mvec pr
2d70: 69 6d 69 74 69 76 65 73 0a 20 20 20 20 23 73 6f  imitives.    #so
2d80: 75 72 63 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20  urce [file join 
2d90: 5b 69 6e 66 6f 20 64 69 72 6e 61 6d 65 20 5b 69  [info dirname [i
2da0: 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 64 65 63  nfo script]] dec
2db0: 6f 64 65 2e 74 63 6c 5d 0a 0a 20 20 20 20 6e 61  ode.tcl]..    na
2dc0: 6d 65 73 70 61 63 65 20 65 78 70 6f 72 74 20 6d  mespace export m
2dd0: 6b 5f 2a 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6b  k_*..    proc mk
2de0: 5f 66 69 6c 65 20 7b 63 6d 64 20 61 72 67 73 7d  _file {cmd args}
2df0: 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20 5b   {.#set indent [
2e00: 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 22 20  string repeat " 
2e10: 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65 6c     " [info level
2e20: 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72 20  ]].#puts stderr 
2e30: 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47 3a  "${indent}DEBUG:
2e40: 20 6d 6b 3a 3a 66 69 6c 65 20 24 63 6d 64 20 24   mk::file $cmd $
2e50: 61 72 67 73 22 0a 09 6c 61 73 73 69 67 6e 20 24  args"..lassign $
2e60: 61 72 67 73 20 64 62 20 66 69 6c 65 0a 09 73 77  args db file..sw
2e70: 69 74 63 68 20 24 63 6d 64 20 7b 0a 09 20 20 20  itch $cmd {..   
2e80: 20 6f 70 65 6e 20 7b 0a 09 09 20 20 20 20 72 65   open {...    re
2e90: 74 75 72 6e 20 5b 64 62 6f 70 65 6e 20 24 64 62  turn [dbopen $db
2ea0: 20 24 66 69 6c 65 5d 0a 09 09 7d 0a 09 20 20 20   $file]...}..   
2eb0: 20 63 6c 6f 73 65 20 7b 0a 09 09 20 20 20 20 64   close {...    d
2ec0: 62 63 6c 6f 73 65 20 24 64 62 0a 09 09 7d 0a 09  bclose $db...}..
2ed0: 20 20 20 20 76 69 65 77 73 20 7b 0a 09 09 20 20      views {...  
2ee0: 20 20 72 65 74 75 72 6e 20 5b 76 6e 61 6d 65 73    return [vnames
2ef0: 20 5b 64 62 74 72 65 65 20 24 64 62 5d 5d 0a 09   [dbtree $db]]..
2f00: 09 7d 0a 09 20 20 20 20 63 6f 6d 6d 69 74 20 7b  .}..    commit {
2f10: 0a 0a 09 09 7d 0a 09 20 20 20 20 64 65 66 61 75  ....}..    defau
2f20: 6c 74 20 7b 0a 09 09 20 20 20 20 65 72 72 6f 72  lt {...    error
2f30: 20 22 6d 6b 5f 66 69 6c 65 20 24 63 6d 64 3f 22   "mk_file $cmd?"
2f40: 0a 09 09 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20  ...}..}.    }.. 
2f50: 20 20 20 70 72 6f 63 20 6d 6b 5f 76 69 65 77 20     proc mk_view 
2f60: 7b 63 6d 64 20 70 61 74 68 20 61 72 67 73 7d 20  {cmd path args} 
2f70: 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20 5b 73  {.#set indent [s
2f80: 74 72 69 6e 67 20 72 65 70 65 61 74 20 22 20 20  tring repeat "  
2f90: 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65 6c 5d    " [info level]
2fa0: 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72 20 22  ].#puts stderr "
2fb0: 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47 3a 20  ${indent}DEBUG: 
2fc0: 6d 6b 3a 3a 76 69 65 77 20 24 63 6d 64 20 24 70  mk::view $cmd $p
2fd0: 61 74 68 20 24 61 72 67 73 22 0a 09 6c 61 73 73  ath $args"..lass
2fe0: 69 67 6e 20 24 61 72 67 73 20 61 31 0a 09 73 77  ign $args a1..sw
2ff0: 69 74 63 68 20 24 63 6d 64 20 7b 0a 09 20 20 20  itch $cmd {..   
3000: 20 69 6e 66 6f 20 7b 0a 09 09 20 20 20 20 72 65   info {...    re
3010: 74 75 72 6e 20 5b 76 6e 61 6d 65 73 20 5b 61 63  turn [vnames [ac
3020: 63 65 73 73 20 24 70 61 74 68 5d 5d 0a 09 09 7d  cess $path]]...}
3030: 0a 09 20 20 20 20 6c 61 79 6f 75 74 20 7b 0a 09  ..    layout {..
3040: 09 20 20 20 20 73 65 74 20 6c 61 79 6f 75 74 20  .    set layout 
3050: 22 4e 4f 54 59 45 54 22 0a 09 09 20 20 20 20 69  "NOTYET"...    i
3060: 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67  f {[llength $arg
3070: 73 5d 20 3e 20 30 20 26 26 20 24 6c 61 79 6f 75  s] > 0 && $layou
3080: 74 20 21 3d 20 24 61 31 7d 20 7b 0a 09 09 09 23  t != $a1} {....#
3090: 65 72 72 6f 72 20 22 76 69 65 77 20 72 65 73 74  error "view rest
30a0: 72 75 63 74 75 72 69 6e 67 20 6e 6f 74 20 73 75  ructuring not su
30b0: 70 70 6f 72 74 65 64 22 0a 09 09 20 20 20 20 7d  pported"...    }
30c0: 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 24 6c  ...    return $l
30d0: 61 79 6f 75 74 0a 09 09 7d 0a 09 20 20 20 20 73  ayout...}..    s
30e0: 69 7a 65 20 7b 0a 09 09 20 20 20 20 73 65 74 20  ize {...    set 
30f0: 6c 65 6e 20 5b 76 6c 65 6e 20 5b 61 63 63 65 73  len [vlen [acces
3100: 73 20 24 70 61 74 68 5d 5d 0a 09 09 20 20 20 20  s $path]]...    
3110: 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 72  if {[llength $ar
3120: 67 73 5d 20 3e 20 30 20 26 26 20 24 6c 65 6e 20  gs] > 0 && $len 
3130: 21 3d 20 24 61 31 7d 20 7b 0a 09 09 09 65 72 72  != $a1} {....err
3140: 6f 72 20 22 76 69 65 77 20 72 65 73 69 7a 69 6e  or "view resizin
3150: 67 20 6e 6f 74 20 73 75 70 70 6f 72 74 65 64 22  g not supported"
3160: 0a 09 09 20 20 20 20 7d 0a 09 09 20 20 20 20 72  ...    }...    r
3170: 65 74 75 72 6e 20 5b 76 6c 65 6e 20 5b 61 63 63  eturn [vlen [acc
3180: 65 73 73 20 24 70 61 74 68 5d 5d 0a 09 09 7d 0a  ess $path]]...}.
3190: 09 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a 09  .    default {..
31a0: 09 20 20 20 20 65 72 72 6f 72 20 22 6d 6b 5f 76  .    error "mk_v
31b0: 69 65 77 20 24 63 6d 64 3f 22 0a 09 09 7d 0a 09  iew $cmd?"...}..
31c0: 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f  }.    }..    pro
31d0: 63 20 6d 6b 5f 63 75 72 73 6f 72 20 7b 63 6d 64  c mk_cursor {cmd
31e0: 20 63 75 72 73 6f 72 20 61 72 67 73 7d 20 7b 0a   cursor args} {.
31f0: 23 73 65 74 20 69 6e 64 65 6e 74 20 5b 73 74 72  #set indent [str
3200: 69 6e 67 20 72 65 70 65 61 74 20 22 20 20 20 20  ing repeat "    
3210: 22 20 5b 69 6e 66 6f 20 6c 65 76 65 6c 5d 5d 0a  " [info level]].
3220: 23 70 75 74 73 20 73 74 64 65 72 72 20 22 24 7b  #puts stderr "${
3230: 69 6e 64 65 6e 74 7d 44 45 42 55 47 3a 20 6d 6b  indent}DEBUG: mk
3240: 3a 3a 63 75 72 73 6f 72 20 24 63 6d 64 20 24 63  ::cursor $cmd $c
3250: 75 72 73 6f 72 20 24 61 72 67 73 22 0a 09 75 70  ursor $args"..up
3260: 76 61 72 20 24 63 75 72 73 6f 72 20 76 0a 09 73  var $cursor v..s
3270: 77 69 74 63 68 20 24 63 6d 64 20 7b 0a 09 20 20  witch $cmd {..  
3280: 20 20 63 72 65 61 74 65 20 7b 0a 09 09 20 20 20    create {...   
3290: 20 4e 4f 54 59 45 54 0a 09 09 7d 0a 09 20 20 20   NOTYET...}..   
32a0: 20 69 6e 63 72 20 7b 0a 09 09 20 20 20 20 4e 4f   incr {...    NO
32b0: 54 59 45 54 0a 09 09 7d 0a 09 20 20 20 20 70 6f  TYET...}..    po
32c0: 73 20 2d 0a 09 20 20 20 20 70 6f 73 69 74 69 6f  s -..    positio
32d0: 6e 20 7b 0a 09 09 20 20 20 20 69 66 20 7b 24 61  n {...    if {$a
32e0: 72 67 73 20 21 3d 20 22 22 7d 20 7b 0a 09 09 09  rgs != ""} {....
32f0: 72 65 67 73 75 62 20 7b 21 2d 3f 5c 64 2b 24 7d  regsub {!-?\d+$}
3300: 20 24 76 20 7b 7d 20 76 0a 09 09 09 61 70 70 65   $v {} v....appe
3310: 6e 64 20 76 20 21 24 61 72 67 73 0a 09 09 09 72  nd v !$args....r
3320: 65 74 75 72 6e 20 24 61 72 67 73 0a 09 09 20 20  eturn $args...  
3330: 20 20 7d 0a 09 09 20 20 20 20 69 66 20 7b 21 5b    }...    if {![
3340: 72 65 67 65 78 70 20 7b 5c 64 2b 24 7d 20 24 76  regexp {\d+$} $v
3350: 20 6e 5d 7d 20 7b 0a 09 09 09 73 65 74 20 6e 20   n]} {....set n 
3360: 2d 31 0a 09 09 20 20 20 20 7d 0a 09 09 20 20 20  -1...    }...   
3370: 20 72 65 74 75 72 6e 20 24 6e 0a 09 09 7d 0a 09   return $n...}..
3380: 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a 09 09      default {...
3390: 20 20 20 20 65 72 72 6f 72 20 22 6d 6b 5f 63 75      error "mk_cu
33a0: 72 73 6f 72 20 24 63 6d 64 3f 22 0a 09 09 7d 0a  rsor $cmd?"...}.
33b0: 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72  .}.    }..    pr
33c0: 6f 63 20 6d 6b 5f 67 65 74 20 7b 70 61 74 68 20  oc mk_get {path 
33d0: 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e 64  args} {.#set ind
33e0: 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 65  ent [string repe
33f0: 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f 20  at "    " [info 
3400: 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74  level]].#puts st
3410: 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44  derr "${indent}D
3420: 45 42 55 47 3a 20 6d 6b 3a 3a 67 65 74 20 24 70  EBUG: mk::get $p
3430: 61 74 68 20 24 61 72 67 73 22 0a 09 73 65 74 20  ath $args"..set 
3440: 72 6f 77 72 65 66 20 5b 61 63 63 65 73 73 20 24  rowref [access $
3450: 70 61 74 68 5d 0a 09 73 65 74 20 73 69 7a 65 64  path]..set sized
3460: 20 30 0a 09 69 66 20 7b 5b 6c 69 6e 64 65 78 20   0..if {[lindex 
3470: 24 61 72 67 73 20 30 5d 20 3d 3d 20 22 2d 73 69  $args 0] == "-si
3480: 7a 65 22 7d 20 7b 0a 09 20 20 20 20 73 65 74 20  ze"} {..    set 
3490: 73 69 7a 65 64 20 31 0a 09 20 20 20 20 73 65 74  sized 1..    set
34a0: 20 61 72 67 73 20 5b 6c 72 61 6e 67 65 20 24 61   args [lrange $a
34b0: 72 67 73 20 31 20 65 6e 64 5d 0a 09 7d 0a 09 73  rgs 1 end]..}..s
34c0: 65 74 20 69 64 73 20 30 0a 09 69 66 20 7b 5b 6c  et ids 0..if {[l
34d0: 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 3d 3d  length $args] ==
34e0: 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 61   0} {..    set a
34f0: 72 67 73 20 5b 76 6e 61 6d 65 73 20 24 72 6f 77  rgs [vnames $row
3500: 72 65 66 5d 0a 09 20 20 20 20 73 65 74 20 69 64  ref]..    set id
3510: 73 20 31 0a 09 7d 0a 09 73 65 74 20 72 20 7b 7d  s 1..}..set r {}
3520: 0a 09 66 6f 72 65 61 63 68 20 78 20 24 61 72 67  ..foreach x $arg
3530: 73 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 69 64  s {..    if {$id
3540: 73 7d 20 7b 0a 09 09 6c 61 70 70 65 6e 64 20 72  s} {...lappend r
3550: 20 24 78 0a 09 20 20 20 20 7d 0a 09 20 20 20 20   $x..    }..    
3560: 73 65 74 20 76 20 5b 6d 76 65 63 20 24 72 6f 77  set v [mvec $row
3570: 72 65 66 20 24 78 5d 0a 69 66 20 7b 5b 73 74 72  ref $x].if {[str
3580: 69 6e 67 20 72 61 6e 67 65 20 24 76 20 30 20 38  ing range $v 0 8
3590: 5d 20 3d 3d 20 22 67 65 74 5f 76 69 65 77 20 22  ] == "get_view "
35a0: 7d 20 7b 0a 23 20 58 58 58 3a 20 3f 21 3f 21 3f  } {.# XXX: ?!?!?
35b0: 3a 20 54 4f 44 4f 3a 20 46 49 58 0a 73 65 74 20  : TODO: FIX.set 
35c0: 76 20 31 0a 7d 0a 09 20 20 20 20 63 61 74 63 68  v 1.}..    catch
35d0: 20 7b 0a 09 09 73 65 74 20 76 20 5b 7a 6c 69 62   {...set v [zlib
35e0: 20 64 65 63 6f 6d 70 72 65 73 73 20 24 76 5d 0a   decompress $v].
35f0: 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b  .    }..    if {
3600: 24 73 69 7a 65 64 7d 20 7b 0a 09 09 6c 61 70 70  $sized} {...lapp
3610: 65 6e 64 20 72 20 5b 73 74 72 69 6e 67 20 6c 65  end r [string le
3620: 6e 67 74 68 20 24 76 5d 0a 09 20 20 20 20 7d 20  ngth $v]..    } 
3630: 65 6c 73 65 20 7b 0a 09 09 6c 61 70 70 65 6e 64  else {...lappend
3640: 20 72 20 24 76 0a 09 20 20 20 20 7d 0a 09 7d 0a   r $v..    }..}.
3650: 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61  .if {[llength $a
3660: 72 67 73 5d 20 3d 3d 20 31 7d 20 7b 0a 09 20 20  rgs] == 1} {..  
3670: 20 20 73 65 74 20 72 20 5b 6c 69 6e 64 65 78 20    set r [lindex 
3680: 24 72 20 30 5d 0a 09 7d 0a 0a 09 72 65 74 75 72  $r 0]..}...retur
3690: 6e 20 24 72 0a 20 20 20 20 7d 0a 0a 20 20 20 20  n $r.    }..    
36a0: 70 72 6f 63 20 6d 6b 5f 6c 6f 6f 70 20 7b 63 75  proc mk_loop {cu
36b0: 72 73 6f 72 20 70 61 74 68 20 61 72 67 73 7d 20  rsor path args} 
36c0: 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20 5b 73  {.#set indent [s
36d0: 74 72 69 6e 67 20 72 65 70 65 61 74 20 22 20 20  tring repeat "  
36e0: 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65 6c 5d    " [info level]
36f0: 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72 20 22  ].#puts stderr "
3700: 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47 3a 20  ${indent}DEBUG: 
3710: 6d 6b 3a 3a 6c 6f 6f 70 20 24 63 75 72 73 6f 72  mk::loop $cursor
3720: 20 24 70 61 74 68 20 2e 2e 2e 22 0a 09 75 70 76   $path ..."..upv
3730: 61 72 20 24 63 75 72 73 6f 72 20 76 0a 09 69 66  ar $cursor v..if
3740: 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 73   {[llength $args
3750: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73  ] == 0} {..    s
3760: 65 74 20 61 72 67 73 20 5b 6c 69 73 74 20 24 70  et args [list $p
3770: 61 74 68 5d 0a 09 20 20 20 20 73 65 74 20 70 61  ath]..    set pa
3780: 74 68 20 24 76 0a 09 20 20 20 20 72 65 67 73 75  th $v..    regsu
3790: 62 20 7b 21 2d 3f 5c 64 2b 24 7d 20 24 70 61 74  b {!-?\d+$} $pat
37a0: 68 20 7b 7d 20 70 61 74 68 0a 09 7d 0a 09 6c 61  h {} path..}..la
37b0: 73 73 69 67 6e 20 24 61 72 67 73 20 61 31 20 61  ssign $args a1 a
37c0: 32 20 61 33 20 61 34 0a 09 73 65 74 20 72 6f 77  2 a3 a4..set row
37d0: 72 65 66 20 5b 61 63 63 65 73 73 20 24 70 61 74  ref [access $pat
37e0: 68 5d 0a 09 73 65 74 20 66 69 72 73 74 20 30 0a  h]..set first 0.
37f0: 09 73 65 74 20 6c 69 6d 69 74 20 5b 76 6c 65 6e  .set limit [vlen
3800: 20 24 72 6f 77 72 65 66 5d 0a 09 73 65 74 20 73   $rowref]..set s
3810: 74 65 70 20 31 0a 09 73 77 69 74 63 68 20 5b 6c  tep 1..switch [l
3820: 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 7b 0a  length $args] {.
3830: 09 20 20 20 20 31 20 7b 0a 09 09 20 20 20 20 73  .    1 {...    s
3840: 65 74 20 62 6f 64 79 20 24 61 31 0a 09 09 7d 0a  et body $a1...}.
3850: 09 20 20 20 20 32 20 7b 0a 09 09 20 20 20 20 73  .    2 {...    s
3860: 65 74 20 66 69 72 73 74 20 24 61 31 0a 09 09 20  et first $a1... 
3870: 20 20 20 73 65 74 20 62 6f 64 79 20 24 61 32 0a     set body $a2.
3880: 09 09 7d 0a 09 20 20 20 20 33 20 7b 0a 09 09 20  ..}..    3 {... 
3890: 20 20 20 73 65 74 20 66 69 72 73 74 20 24 61 31     set first $a1
38a0: 0a 09 09 20 20 20 20 73 65 74 20 6c 69 6d 69 74  ...    set limit
38b0: 20 24 61 32 0a 09 09 20 20 20 20 73 65 74 20 62   $a2...    set b
38c0: 6f 64 79 20 24 61 33 0a 09 09 7d 0a 09 20 20 20  ody $a3...}..   
38d0: 20 34 20 7b 0a 09 09 20 20 20 20 73 65 74 20 66   4 {...    set f
38e0: 69 72 73 74 20 24 61 31 0a 09 09 20 20 20 20 73  irst $a1...    s
38f0: 65 74 20 6c 69 6d 69 74 20 24 61 32 0a 09 09 20  et limit $a2... 
3900: 20 20 20 73 65 74 20 73 74 65 70 20 24 61 33 0a     set step $a3.
3910: 09 09 20 20 20 20 73 65 74 20 62 6f 64 79 20 24  ..    set body $
3920: 61 34 0a 09 09 7d 0a 09 20 20 20 20 64 65 66 61  a4...}..    defa
3930: 75 6c 74 20 7b 0a 09 09 20 20 20 20 65 72 72 6f  ult {...    erro
3940: 72 20 22 6d 6b 5f 6c 6f 6f 70 20 61 72 67 20 63  r "mk_loop arg c
3950: 6f 75 6e 74 3f 22 0a 09 09 7d 0a 09 7d 0a 09 73  ount?"...}..}..s
3960: 65 74 20 63 6f 64 65 20 30 0a 09 66 6f 72 20 7b  et code 0..for {
3970: 73 65 74 20 69 20 24 66 69 72 73 74 7d 20 7b 24  set i $first} {$
3980: 69 20 3c 20 24 6c 69 6d 69 74 7d 20 7b 69 6e 63  i < $limit} {inc
3990: 72 20 69 20 24 73 74 65 70 7d 20 7b 0a 09 20 20  r i $step} {..  
39a0: 20 20 73 65 74 20 76 20 24 70 61 74 68 21 24 69    set v $path!$i
39b0: 0a 09 20 20 20 20 73 65 74 20 63 6f 64 65 20 5b  ..    set code [
39c0: 63 61 74 63 68 20 5b 6c 69 73 74 20 75 70 6c 65  catch [list uple
39d0: 76 65 6c 20 31 20 24 62 6f 64 79 5d 20 65 72 72  vel 1 $body] err
39e0: 5d 0a 09 20 20 20 20 73 77 69 74 63 68 20 24 63  ]..    switch $c
39f0: 6f 64 65 20 7b 0a 09 09 31 20 2d 0a 09 09 32 20  ode {...1 -...2 
3a00: 7b 0a 09 09 09 72 65 74 75 72 6e 20 2d 63 6f 64  {....return -cod
3a10: 65 20 24 63 6f 64 65 20 24 65 72 72 0a 09 09 20  e $code $err... 
3a20: 20 20 20 7d 0a 09 09 33 20 7b 0a 09 09 09 62 72     }...3 {....br
3a30: 65 61 6b 0a 09 09 20 20 20 20 7d 0a 09 20 20 20  eak...    }..   
3a40: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20   }..}.    }..   
3a50: 20 70 72 6f 63 20 6d 6b 5f 73 65 6c 65 63 74 20   proc mk_select 
3a60: 7b 70 61 74 68 20 61 72 67 73 7d 20 7b 0a 23 73  {path args} {.#s
3a70: 65 74 20 69 6e 64 65 6e 74 20 5b 73 74 72 69 6e  et indent [strin
3a80: 67 20 72 65 70 65 61 74 20 22 20 20 20 20 22 20  g repeat "    " 
3a90: 5b 69 6e 66 6f 20 6c 65 76 65 6c 5d 5d 0a 23 70  [info level]].#p
3aa0: 75 74 73 20 73 74 64 65 72 72 20 22 24 7b 69 6e  uts stderr "${in
3ab0: 64 65 6e 74 7d 44 45 42 55 47 3a 20 6d 6b 3a 3a  dent}DEBUG: mk::
3ac0: 73 65 6c 65 63 74 20 24 70 61 74 68 20 24 61 72  select $path $ar
3ad0: 67 73 22 0a 09 23 20 6f 6e 6c 79 20 68 61 6e 64  gs"..# only hand
3ae0: 6c 65 20 74 68 65 20 73 69 6d 70 6c 65 73 74 20  le the simplest 
3af0: 63 61 73 65 3a 20 65 78 61 63 74 20 6d 61 74 63  case: exact matc
3b00: 68 65 73 0a 09 69 66 20 7b 5b 6c 69 6e 64 65 78  hes..if {[lindex
3b10: 20 24 61 72 67 73 20 30 5d 20 3d 3d 20 22 2d 63   $args 0] == "-c
3b20: 6f 75 6e 74 22 7d 20 7b 0a 09 09 73 65 74 20 6d  ount"} {...set m
3b30: 61 78 69 74 65 6d 73 20 5b 6c 69 6e 64 65 78 20  axitems [lindex 
3b40: 24 61 72 67 73 20 31 5d 0a 09 09 73 65 74 20 61  $args 1]...set a
3b50: 72 67 73 20 5b 6c 72 61 6e 67 65 20 24 61 72 67  rgs [lrange $arg
3b60: 73 20 32 20 65 6e 64 5d 0a 09 7d 0a 0a 09 73 65  s 2 end]..}...se
3b70: 74 20 63 75 72 72 6d 61 74 63 68 6d 6f 64 65 20  t currmatchmode 
3b80: 22 63 61 73 65 69 6e 73 65 6e 73 69 74 69 76 65  "caseinsensitive
3b90: 22 0a 0a 09 73 65 74 20 6b 65 79 73 20 7b 7d 0a  "...set keys {}.
3ba0: 09 73 65 74 20 76 61 6c 75 65 20 7b 7d 0a 09 73  .set value {}..s
3bb0: 65 74 20 6d 61 74 63 68 6d 6f 64 65 73 20 7b 7d  et matchmodes {}
3bc0: 0a 09 66 6f 72 20 7b 73 65 74 20 69 64 78 20 30  ..for {set idx 0
3bd0: 7d 20 7b 24 69 64 78 20 3c 20 5b 6c 6c 65 6e 67  } {$idx < [lleng
3be0: 74 68 20 24 61 72 67 73 5d 7d 20 7b 69 6e 63 72  th $args]} {incr
3bf0: 20 69 64 78 20 32 7d 20 7b 0a 09 09 73 77 69 74   idx 2} {...swit
3c00: 63 68 20 2d 67 6c 6f 62 20 2d 2d 20 5b 6c 69 6e  ch -glob -- [lin
3c10: 64 65 78 20 24 61 72 67 73 20 24 69 64 78 5d 20  dex $args $idx] 
3c20: 7b 0a 09 09 09 22 2d 67 6c 6f 62 22 20 7b 0a 09  {...."-glob" {..
3c30: 09 09 09 73 65 74 20 63 75 72 72 6d 61 74 63 68  ...set currmatch
3c40: 6d 6f 64 65 20 22 67 6c 6f 62 22 0a 09 09 09 09  mode "glob".....
3c50: 69 6e 63 72 20 69 64 78 20 2d 31 0a 09 09 09 09  incr idx -1.....
3c60: 63 6f 6e 74 69 6e 75 65 0a 09 09 09 7d 0a 09 09  continue....}...
3c70: 09 22 2d 2a 22 20 7b 0a 09 09 09 09 65 72 72 6f  ."-*" {.....erro
3c80: 72 20 22 55 6e 68 61 6e 64 6c 65 64 20 6f 70 74  r "Unhandled opt
3c90: 69 6f 6e 3a 20 5b 6c 69 6e 64 65 78 20 24 61 72  ion: [lindex $ar
3ca0: 67 73 20 24 69 64 78 5d 22 0a 09 09 09 7d 0a 09  gs $idx]"....}..
3cb0: 09 7d 0a 0a 09 09 73 65 74 20 6b 20 5b 6c 69 6e  .}....set k [lin
3cc0: 64 65 78 20 24 61 72 67 73 20 24 69 64 78 5d 0a  dex $args $idx].
3cd0: 09 09 73 65 74 20 76 20 5b 6c 69 6e 64 65 78 20  ..set v [lindex 
3ce0: 24 61 72 67 73 20 5b 65 78 70 72 20 7b 24 69 64  $args [expr {$id
3cf0: 78 2b 31 7d 5d 5d 0a 0a 09 09 6c 61 70 70 65 6e  x+1}]]....lappen
3d00: 64 20 6b 65 79 73 20 24 6b 0a 09 09 6c 61 70 70  d keys $k...lapp
3d10: 65 6e 64 20 76 61 6c 75 65 73 20 24 76 0a 09 09  end values $v...
3d20: 6c 61 70 70 65 6e 64 20 6d 61 74 63 68 6d 6f 64  lappend matchmod
3d30: 65 73 20 24 63 75 72 72 6d 61 74 63 68 6d 6f 64  es $currmatchmod
3d40: 65 0a 09 7d 0a 09 73 65 74 20 72 20 7b 7d 0a 09  e..}..set r {}..
3d50: 6d 6b 5f 6c 6f 6f 70 20 63 20 24 70 61 74 68 20  mk_loop c $path 
3d60: 7b 0a 09 09 73 65 74 20 78 20 5b 65 76 61 6c 20  {...set x [eval 
3d70: 6d 6b 5f 67 65 74 20 24 63 20 24 6b 65 79 73 5d  mk_get $c $keys]
3d80: 0a 09 09 73 65 74 20 6d 61 74 63 68 43 6e 74 20  ...set matchCnt 
3d90: 30 0a 09 09 66 6f 72 20 7b 73 65 74 20 69 64 78  0...for {set idx
3da0: 20 30 7d 20 7b 24 69 64 78 20 3c 20 5b 6c 6c 65   0} {$idx < [lle
3db0: 6e 67 74 68 20 24 78 5d 7d 20 7b 69 6e 63 72 20  ngth $x]} {incr 
3dc0: 69 64 78 7d 20 7b 0a 09 09 09 73 65 74 20 76 61  idx} {....set va
3dd0: 6c 20 5b 6c 69 6e 64 65 78 20 24 76 61 6c 75 65  l [lindex $value
3de0: 73 20 24 69 64 78 5d 0a 09 09 09 73 65 74 20 63  s $idx]....set c
3df0: 68 6b 76 61 6c 20 5b 6c 69 6e 64 65 78 20 24 78  hkval [lindex $x
3e00: 20 24 69 64 78 5d 0a 09 09 09 73 65 74 20 6d 61   $idx]....set ma
3e10: 74 63 68 6d 6f 64 65 20 5b 6c 69 6e 64 65 78 20  tchmode [lindex 
3e20: 24 6d 61 74 63 68 6d 6f 64 65 73 20 24 69 64 78  $matchmodes $idx
3e30: 5d 0a 0a 09 09 09 73 77 69 74 63 68 20 2d 2d 20  ].....switch -- 
3e40: 24 6d 61 74 63 68 6d 6f 64 65 20 7b 0a 09 09 09  $matchmode {....
3e50: 09 22 63 61 73 65 69 6e 73 65 6e 73 69 74 69 76  ."caseinsensitiv
3e60: 65 22 20 7b 0a 09 09 09 09 09 69 66 20 7b 24 76  e" {......if {$v
3e70: 61 6c 20 3d 3d 20 24 63 68 6b 76 61 6c 7d 20 7b  al == $chkval} {
3e80: 0a 09 09 09 09 09 09 69 6e 63 72 20 6d 61 74 63  .......incr matc
3e90: 68 43 6e 74 0a 09 09 09 09 09 7d 0a 09 09 09 09  hCnt......}.....
3ea0: 7d 0a 09 09 09 09 22 67 6c 6f 62 22 20 7b 0a 09  }....."glob" {..
3eb0: 09 09 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20  ....if {[string 
3ec0: 6d 61 74 63 68 20 24 76 61 6c 20 24 63 68 6b 76  match $val $chkv
3ed0: 61 6c 5d 7d 20 7b 0a 09 09 09 09 09 09 69 6e 63  al]} {.......inc
3ee0: 72 20 6d 61 74 63 68 43 6e 74 0a 09 09 09 09 09  r matchCnt......
3ef0: 7d 0a 09 09 09 09 7d 0a 09 09 09 7d 0a 0a 09 09  }.....}....}....
3f00: 7d 0a 09 09 69 66 20 7b 24 6d 61 74 63 68 43 6e  }...if {$matchCn
3f10: 74 20 3d 3d 20 5b 6c 6c 65 6e 67 74 68 20 24 6b  t == [llength $k
3f20: 65 79 73 5d 7d 20 7b 0a 09 09 09 6c 61 70 70 65  eys]} {....lappe
3f30: 6e 64 20 72 20 5b 6d 6b 5f 63 75 72 73 6f 72 20  nd r [mk_cursor 
3f40: 70 6f 73 69 74 69 6f 6e 20 63 5d 0a 09 09 7d 0a  position c]...}.
3f50: 09 7d 0a 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65  .}...if {[info e
3f60: 78 69 73 74 73 20 6d 61 78 69 74 65 6d 73 5d 7d  xists maxitems]}
3f70: 20 7b 0a 09 09 73 65 74 20 72 20 5b 6c 72 61 6e   {...set r [lran
3f80: 67 65 20 24 72 20 30 20 5b 65 78 70 72 20 24 6d  ge $r 0 [expr $m
3f90: 61 78 69 74 65 6d 73 20 2d 20 31 5d 5d 0a 09 7d  axitems - 1]]..}
3fa0: 0a 0a 09 72 65 74 75 72 6e 20 24 72 0a 20 20 20  ...return $r.   
3fb0: 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6b 5f   }..    proc mk_
3fc0: 5f 72 65 63 68 61 6e 20 7b 70 61 74 68 20 70 72  _rechan {path pr
3fd0: 6f 70 20 63 6d 64 20 63 68 61 6e 20 61 72 67 73  op cmd chan args
3fe0: 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20  } {.#set indent 
3ff0: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 22  [string repeat "
4000: 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65      " [info leve
4010: 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72  l]].#puts stderr
4020: 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47   "${indent}DEBUG
4030: 3a 20 6d 6b 3a 3a 5f 72 65 63 68 61 6e 20 24 70  : mk::_rechan $p
4040: 61 74 68 20 24 70 72 6f 70 20 24 63 6d 64 20 24  ath $prop $cmd $
4050: 63 68 61 6e 20 24 61 72 67 73 22 0a 0a 20 20 20  chan $args"..   
4060: 20 20 20 20 20 73 65 74 20 6b 65 79 20 5b 6c 69       set key [li
4070: 73 74 20 24 70 61 74 68 20 24 70 72 6f 70 5d 0a  st $path $prop].
4080: 20 20 20 20 20 20 20 20 69 66 20 7b 21 5b 69 6e          if {![in
4090: 66 6f 20 65 78 69 73 74 73 20 3a 3a 6d 6b 5f 5f  fo exists ::mk__
40a0: 63 61 63 68 65 28 24 6b 65 79 29 5d 7d 20 7b 0a  cache($key)]} {.
40b0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a            set ::
40c0: 6d 6b 5f 5f 63 61 63 68 65 28 24 6b 65 79 29 20  mk__cache($key) 
40d0: 5b 6d 6b 3a 3a 67 65 74 20 24 70 61 74 68 20 24  [mk::get $path $
40e0: 70 72 6f 70 5d 0a 20 20 20 20 20 20 20 20 7d 0a  prop].        }.
40f0: 20 20 20 20 20 20 20 20 69 66 20 7b 21 5b 69 6e          if {![in
4100: 66 6f 20 65 78 69 73 74 73 20 3a 3a 6d 6b 5f 5f  fo exists ::mk__
4110: 6f 66 66 73 65 74 28 24 6b 65 79 29 5d 7d 20 7b  offset($key)]} {
4120: 0a 20 20 20 20 20 20 20 20 20 20 73 65 74 20 3a  .          set :
4130: 3a 6d 6b 5f 5f 6f 66 66 73 65 74 28 24 6b 65 79  :mk__offset($key
4140: 29 20 30 0a 20 20 20 20 20 20 20 20 7d 0a 20 20  ) 0.        }.  
4150: 20 20 20 20 20 20 73 65 74 20 64 61 74 61 20 24        set data $
4160: 3a 3a 6d 6b 5f 5f 63 61 63 68 65 28 24 6b 65 79  ::mk__cache($key
4170: 29 0a 20 20 20 20 20 20 20 20 73 65 74 20 6f 66  ).        set of
4180: 66 73 65 74 20 24 3a 3a 6d 6b 5f 5f 6f 66 66 73  fset $::mk__offs
4190: 65 74 28 24 6b 65 79 29 0a 0a 20 20 20 20 20 20  et($key)..      
41a0: 20 20 73 77 69 74 63 68 20 2d 2d 20 24 63 6d 64    switch -- $cmd
41b0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 22   {.            "
41c0: 72 65 61 64 22 20 7b 0a 20 20 20 20 20 20 20 20  read" {.        
41d0: 20 20 20 20 20 20 20 20 73 65 74 20 63 6f 75 6e          set coun
41e0: 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20  t [lindex $args 
41f0: 30 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  0].             
4200: 20 20 20 73 65 74 20 72 65 74 76 61 6c 20 5b 73     set retval [s
4210: 74 72 69 6e 67 20 72 61 6e 67 65 20 24 64 61 74  tring range $dat
4220: 61 20 24 6f 66 66 73 65 74 20 5b 65 78 70 72 20  a $offset [expr 
4230: 7b 24 6f 66 66 73 65 74 20 2b 20 24 63 6f 75 6e  {$offset + $coun
4240: 74 20 2d 20 31 7d 5d 5d 0a 0a 20 20 20 20 20 20  t - 1}]]..      
4250: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 72 65            set re
4260: 61 64 62 79 74 65 73 20 5b 73 74 72 69 6e 67 20  adbytes [string 
4270: 6c 65 6e 67 74 68 20 24 72 65 74 76 61 6c 5d 0a  length $retval].
4280: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
4290: 20 69 6e 63 72 20 6f 66 66 73 65 74 20 24 72 65   incr offset $re
42a0: 61 64 62 79 74 65 73 0a 20 20 20 20 20 20 20 20  adbytes.        
42b0: 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 20 20      }.          
42c0: 20 20 22 63 6c 6f 73 65 22 20 7b 0a 20 20 20 20    "close" {.    
42d0: 20 20 20 20 20 20 20 20 20 20 20 20 75 6e 73 65              unse
42e0: 74 20 2d 6e 6f 63 6f 6d 70 6c 61 69 6e 20 3a 3a  t -nocomplain ::
42f0: 6d 6b 5f 5f 63 61 63 68 65 28 24 6b 65 79 29 0a  mk__cache($key).
4300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4310: 75 6e 73 65 74 20 2d 6e 6f 63 6f 6d 70 6c 61 69  unset -nocomplai
4320: 6e 20 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 74 28 24  n ::mk__offset($
4330: 6b 65 79 29 0a 20 20 20 20 20 20 20 20 20 20 20  key).           
4340: 20 20 20 20 20 72 65 74 75 72 6e 0a 20 20 20 20       return.    
4350: 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20          }.      
4360: 20 20 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a        default {.
4370: 23 70 75 74 73 20 73 74 64 65 72 72 20 22 24 7b  #puts stderr "${
4380: 69 6e 64 65 6e 74 7d 44 45 42 55 47 3a 20 6d 6b  indent}DEBUG: mk
4390: 3a 3a 5f 72 65 63 68 61 6e 3a 20 43 61 6c 6c 65  ::_rechan: Calle
43a0: 64 20 66 6f 72 20 63 6d 64 20 24 63 6d 64 22 0a  d for cmd $cmd".
43b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
43c0: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72  return -code err
43d0: 6f 72 20 22 4e 6f 74 20 69 6d 70 6c 65 6d 65 6e  or "Not implemen
43e0: 74 65 64 3a 20 63 6d 64 20 3d 20 24 63 6d 64 22  ted: cmd = $cmd"
43f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20  .            }. 
4400: 20 20 20 20 20 20 20 7d 0a 0a 20 20 20 20 20 20         }..      
4410: 20 20 73 65 74 20 3a 3a 6d 6b 5f 5f 6f 66 66 73    set ::mk__offs
4420: 65 74 28 24 6b 65 79 29 20 24 6f 66 66 73 65 74  et($key) $offset
4430: 0a 0a 09 72 65 74 75 72 6e 20 24 72 65 74 76 61  ...return $retva
4440: 6c 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f  l.    }..    pro
4450: 63 20 6d 6b 5f 63 68 61 6e 6e 65 6c 20 7b 70 61  c mk_channel {pa
4460: 74 68 20 70 72 6f 70 20 7b 6d 6f 64 65 20 22 72  th prop {mode "r
4470: 22 7d 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e  "}} {.#set inden
4480: 74 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74  t [string repeat
4490: 20 22 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65   "    " [info le
44a0: 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65  vel]].#puts stde
44b0: 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42  rr "${indent}DEB
44c0: 55 47 3a 20 6d 6b 3a 3a 63 68 61 6e 6e 65 6c 20  UG: mk::channel 
44d0: 24 70 61 74 68 20 24 70 72 6f 70 20 24 6d 6f 64  $path $prop $mod
44e0: 65 22 0a 09 73 65 74 20 66 64 20 5b 72 65 63 68  e"..set fd [rech
44f0: 61 6e 20 5b 6c 69 73 74 20 6d 6b 5f 5f 72 65 63  an [list mk__rec
4500: 68 61 6e 20 24 70 61 74 68 20 24 70 72 6f 70 5d  han $path $prop]
4510: 20 32 5d 0a 0a 09 72 65 74 75 72 6e 20 24 66 64   2]...return $fd
4520: 0a 20 20 20 20 7d 0a 20 20 20 20 23 20 76 69 6d  .    }.    # vim
4530: 3a 20 66 74 3d 74 63 6c 0a 0a 7d 0a 0a 23 20 73  : ft=tcl..}..# s
4540: 65 74 20 75 70 20 74 68 65 20 4d 65 74 61 4b 69  et up the MetaKi
4550: 74 20 63 6f 6d 70 61 74 69 62 69 6c 69 74 79 20  t compatibility 
4560: 64 65 66 69 6e 69 74 69 6f 6e 73 0a 66 6f 72 65  definitions.fore
4570: 61 63 68 20 78 20 7b 66 69 6c 65 20 76 69 65 77  ach x {file view
4580: 20 63 75 72 73 6f 72 20 67 65 74 20 6c 6f 6f 70   cursor get loop
4590: 20 73 65 6c 65 63 74 20 63 68 61 6e 6e 65 6c 7d   select channel}
45a0: 20 7b 0a 20 20 20 20 69 6e 74 65 72 70 20 61 6c   {.    interp al
45b0: 69 61 73 20 7b 7d 20 3a 3a 6d 6b 3a 3a 24 78 20  ias {} ::mk::$x 
45c0: 7b 7d 20 3a 3a 6d 6b 5f 24 78 0a 7d 0a 0a 70 61  {} ::mk_$x.}..pa
45d0: 63 6b 61 67 65 20 70 72 6f 76 69 64 65 20 4d 6b  ckage provide Mk
45e0: 34 74 63 6c 20 32 2e 34 2e 30 2e 31 0a           4tcl 2.4.0.1.