[CMCc] Some code to map metakit views to arrays of dictionaries ====== namespace eval dattach { variable debug 0 proc Write {view selector array var el op} { upvar $var val variable debug if {$debug} { puts stderr "Write: '$view' '$selector' '$array' '$var' '$el' '$op'" puts stderr "V: $val($el)" catch {[dict get $val($el)]} err puts stderr "Err: $err" } set row [::mk::select $view $selector $el] if {[llength $row]} { eval ::mk::set ${view}.$row [dict get $val($el)] $selector $el } else { eval ::mk::row append $view [dict get $val($el)] $selector $el } } proc Read {view selector array var el op} { upvar $var val variable debug if {$debug} { puts stderr "Read: '$view' '$selector' '$array' '$var' '$el' '$op'" } set row [::mk::select $view $selector $el] if {[llength $row]} { set val($el) [eval dict create [::mk::get ${view}.$row]] } else { error "dattach can't read \"${array}\(${el}\): no such element in array" } } proc Unset {view selector array var el op} { upvar $var val variable debug if {$debug} { puts stderr "Unset: '$view' '$selector' '$array' '$var' '$el' '$op'" } if {$el == ""} { puts stderr "Trace: unset1 $view" ::mk::loop el1 ${view} { #catch {puts stderr "Trace: unset2 $el1 [::mk::get $el1]"} catch {::mk::row delete $el1} } puts stderr "Trace: unset done" } else { set row [::mk::select $view $selector $el] ::mk::row delete ${view}.$row } } proc attach {view array {selector ""}} { if {$selector == ""} { set selector [lindex [::mk::view layout $view] 0] } variable debug if {$debug} { puts stderr "dattach: $array to $view $selector" } upvar $array a set a() "" unset a() trace add variable a unset [list ::dattach::Unset $view $selector $array ] trace add variable a read [list ::dattach::Read $view $selector $array ] trace add variable a write [list ::dattach::Write $view $selector $array ] } proc snort {view array {selector ""}} { uplevel ::dattach::attach $view $array $selector upvar $array a ::mk::loop el1 ${view} { set sel [eval dict create [::mk::get $el1]] set a([dict get $sel $selector]) $sel } } namespace export attach snort } ====== and here are a few tests: ====== if {$argv0 == [info script]} { package require Mk4tcl #set ::dattach::debug 1 proc dumpit {heading {var shoesize}} { puts "*** $heading" upvar $var array foreach last [array names array] { if {[catch {puts "$last: $array($last)"} error]} { puts "error on $var element $last: $error" } } puts "---" } set db [mk::file open db /tmp/datafile.mk] set vw [mk::view layout db.people {last first shoesize:I}] # fill in some db rows mk::row append $vw last "Lennon" first "John" shoesize 44 mk::row append $vw last "Gordon" first "Flash" shoesize 42 mk::row append $vw last "Hendrix" first "Jimi" shoesize 49 mk::file commit db ::dattach::attach $vw shoesize last dumpit "attach gets rows lazily - so this will be empty" set x $shoesize(Lennon) set x $shoesize(Gordon) dumpit "Fetch some attached values" set shoesize(Cass) [dict create first Mama shoesize 40 alive n] dumpit "Create a new Row" shoesize dict set shoesize(Cass) last Lennon ;# note, this will have no effect dumpit "changing the key field has no effect" ::dattach::snort $vw shoes last dumpit "snort gets all rows in existence at creation time" shoes dict set shoes(Lennon) shoesize -1 dumpit "changing a different attached variable has an effect on all" shoes # note - we take the first match on key ::dattach::snort $vw size shoesize dumpit "By Shoesize" size dict set shoesize(Cass) shoesize 44 dumpit "array names can get out of sync on snorted arrays\n*** Note: this could be fixed, if trace array was." size } ====== <> Metakit