Purpose: to dicuss TclX's special keyed list [L1 ] functions.
From the TclX man page, you can read:
A keyed list is a list in which each element contains a key and value pair. These element pairs are stored as lists themselves, where the key is the first element of the list, and the value is the second. The key-value pairs are referred to as fields. This is an example of a keyed list:
% package require Tclx
8.4
% keylset person NAME {Frank Zappa} JOB {musician and composer}
% list $person
{{NAME {Frank Zappa}} {JOB {musician and composer}}}Fields may contain subfields; `.' is the separator character. Subfields are actually fields where the value is another keyed list. Thus the following list has the top level fields ID and NAME, and subfields NAME.FIRST and NAME.LAST:
{ID 106} {NAME {{FIRST Frank} {LAST Zappa}}}There is no limit to the recursive depth of subfields, allowing one to build complex data structures.
Keyed lists are constructed and accessed via a number of commands. All keyed list management commands take the name of the variable containing the keyed list as an argument (i.e. passed by reference), rather than passing the list directly.
Delete the field specified by key from the keyed list in the
variable listvar. This removes both the key and the value
from the keyed list. Return the value associated with key from the keyed list in
the variable listvar. If retvar is not specified, then the
value will be returned as the result of the command. In this
case, if key is not found in the list, an error will result.
If retvar is specified and key is in the list, then the
value is returned in the variable retvar and the command
returns 1 if the key was present within the list. If key
isn't in the list, the command will return 0, and retvar
will be left unchanged. If {} is specified for retvar, the
value is not returned, allowing the Tcl programmer to
determine if a key is present in a keyed list without setting a
variable as a side-effect.
If key is omitted, then a list of all the keys in the keyed
list is returned. Return the a list of the keys in the keyed list in the
variable listvar. If keys is specified, then it is the name of
a key field who's subfield keys are to be retrieve. Set the value associated with key, in the keyed list
contained in the variable listvar, to value.
If listvar does not exists, it is created.
If key is not currently in the list, it will be added.
If it already exists, value replaces the existing value.
Multiple keywords and values may be specified, if desired.Is there a way we can ignore dot as separator & treat a whole string together?
Philip Smolen That's one of the reasons I wrote RBTree. By default the key is a simple string, and anything is legal as a key. Other advantages include thread safety, and a significant difference in performance.
DKF: In new code, consider using dict instead. The format's different, but the capabilities are similar.
LV: Is there anyone in the community who would like to create a wiki page that describes how one would modify a program using Tclx's keyed lists to use 8.5 or later's dict? That might be useful to people moving to newer a newer Tcl version.
keylget returns only the value of the 1st element with matching key in the list even if there are multiple same elements.
e.g, in the list {{inventory {{member {{member-type "PC"}}} {member {{member-type "LAPTOP"}}}}}
Here inventory.member.member-type will return only "PC".
I have written a code to get all the elements. Where can I upload the code for comments?
LV If you have the code on a web page or in a web accessible source code repository, just mention the URL here. If you don't have something like that, Google and yahoo both make various resource available for people to make code, etc. available. However, the recommendation is often made these days to moving to Tcl 8.5 and making use of dict instead of Tclx's keyed lists, because dict is going to be supported better than keyed lists are.
Larry Smith One problem I have with both dicts and keyed lists is that each one drags around its own copy of the field names. Not a problem when you have dozens of records, big problem when you have thousands. That's why I wrote records. With records there is just one master copy of the field names, and thereafter each record of that same type only needs the data. I think this is much superior (he said, humbly :).
NEM dicts are Tcl_Obj based so actually the field names can be shared, with a bit of care (even without care, they probably are in many cases).
Here's a little implementation of keyed lists. Except for command names, the implementation mimics the TclX keyed lists for the most part. It requires Tcl 8.5's "lsearch -index <index>" ability. It could easily be written to work in 8.4-, but I wanted to show how easy it was to implement in a small amount of code. -- DC
LV you say for the most part. Which parts of Tclx's keyed lists are not mimic'd?
DC 05-07-2004 -- Though this code has the ability to nest lists and retrieve nested keys within lists, it doesn't support the TclX ability to references them via a dot. TclX's keyed lists were, in part, designed to allow structs in Tcl. So, you could reference nested keys in a list with list1.list2, etc... I didn't really bother with that code. 0-]
SS 28Sep2004 -- Probably people interested in keyed lists may be interested in alists for Tcl.
package require Tcl 8.5
namespace eval ::keyl {}
proc ::keyl::del { listVarName key } {
upvar 1 $listVarName list
::set idx [lsearch -exact -index 0 $list $key]
::set list [lreplace $list $idx $idx]
return
}
proc ::keyl::get { listVarName {key ""} {returnVarName ""} } {
upvar 1 $listVarName $listVarName $listVarName list
if {![string equal $returnVarName ""]} {upvar 1 $returnVarName return }
if {[string equal $key ""]} { return [::keyl::keys $listVarName] }
::set idx [lsearch -exact -index 0 $list $key]
::set return [lindex [lindex $list $idx] 1]
if {[string equal $returnVarName ""]} {
if {$idx < 0} {
return -code error "key \"$key\" not found in keyed list"
} else {
return $return
}
}
return [expr {$idx > -1}]
}
proc ::keyl::keys { listVarName {key ""} } {
upvar 1 $listVarName list
::set keys [list]
if {[string equal $key ""]} {
foreach elem $list {
lappend keys [lindex $elem 0]
}
} else {
::set sublist [lsearch -inline -exact -index 0 $list $key]
foreach elem [lindex $sublist 1] {
lappend keys [lindex $elem 0]
}
}
return $keys
}
proc ::keyl::set { listVarName args } {
upvar 1 $listVarName list
if {![info exists list]} { ::set list [list] }
foreach {key val} $args {
::set idx [lsearch -exact -index 0 $list $key]
if {$idx < 0} {
lappend list [list $key $val]
} else {
::set list [lreplace $list $idx $idx [list $key $val]]
}
}
}SEH 2004-09-17 -- For some reason I have re-implemented Tclx's keyed list commands (keylset, keylget, keylkeys, keyldel) in pure Tcl. Oh yeah, I'm trying to turn sfm into a pure Tcl application.
procedure code below:
proc keyldel {uplistname key} {
upvar $uplistname listname
if ![info exists listname] {error "can't read \"$uplistname\": no such variable"}
foreach keypair $listname {
lappend kargs [lindex $keypair 0]
lappend kargs [lindex $keypair 1]
break
}
eval keylset listname $kargs
set origKey $key
set key [join [split $key .] ::]
if ![namespace exists ::keylists::listname::${key}] {error "key not found: \"$origKey\""}
namespace delete ::keylists::listname::${key}
unset ::keylists::listname::value
lappend eachNamespace ::keylists::listname
lappend allNamespaces ::keylists::listname
while {[llength $eachNamespace] != 0} {
if [catch {lindex [set [lindex $eachNamespace 0]::value] 0} result] {
catch {unset ${eachNamespace}::value} result
}
set allNamespaces [concat $allNamespaces [namespace children [lindex $eachNamespace 0]]]
set eachNamespace [concat $eachNamespace [namespace children [lindex $eachNamespace 0]]]
set eachNamespace [lrange $eachNamespace 1 end]
}
foreach ns [lsort -decreasing $allNamespaces] {
if ![info exists ${ns}::value] {
if [string equal [namespace children $ns] {}] {
namespace delete $ns
continue
}
foreach child [namespace children $ns] {
append ${ns}::value "\[list \"\[list \"[string map "[list ${ns}::] {}" $child]\"] \[list \[set \"${child}::value\"]]\"] "
}
}
}
if ![info exists ::keylists::listname::value] {
namespace eval ::keylists::listname {}
set ::keylists::listname::value {}
}
while {![string equal [set ::keylists::listname::value] [subst -nobackslashes -novariables [set ::keylists::listname::value]]]} {
set ::keylists::listname::value [subst -nobackslashes -novariables [set ::keylists::listname::value]]
}
set listname [string trim [set ::keylists::listname::value]]
set listname [string map {\x00 \[} $listname]
return
}
proc keylget {uplistname args} {
upvar $uplistname listname
if ![info exists listname] {error "can't read \"$uplistname\": no such variable"}
if [string equal $args {}] {
set listargs {}
foreach keypair $listname {
if {[llength $keypair] != 2} {error "keyed list entry must be a two element list, found \"$keypair\""}
lappend listargs [lindex $keypair 0]
lappend listargs [lindex $keypair 1]
}
array set returnValue $listargs
return [lsort [array names returnValue]]
}
set returnBoolean 0
set setVariable 0
if {[llength $args] > 2} {error "wrong # args: keylget listvar ?key? ?retvar | {}?"}
if {[llength $args] == 2} {
set retvar [lindex $args 1]
set returnBoolean 1
if ![string equal $retvar {}] {set setVariable 1 ; upvar $retvar localretvar}
}
foreach keypair $listname {
lappend kargs [lindex $keypair 0]
lappend kargs [lindex $keypair 1]
break
}
eval keylset listname $kargs
set key [lindex $args 0]
set key [join [split $key .] ::]
set missing [catch {set returnValue [set ::keylists::listname::${key}::value]}]
if {$missing && $returnBoolean} {return 0}
if {$missing && !$returnBoolean} {error "key \"[lindex $args 0]\" not found in keyed list"}
while {![string equal $returnValue [subst -nobackslashes -novariables $returnValue]]} {
set returnValue [subst -nobackslashes -novariables $returnValue]
}
set returnValue [string trim $returnValue]
set returnValue [string map {\x00 \[} $returnValue]
if !$returnBoolean {return $returnValue}
if $setVariable {set localretvar $returnValue}
return 1
}
proc keylkeys {uplistname {key {}}} {
upvar $uplistname listname
if ![info exists listname] {error "can't read \"$uplistname\": no such variable"}
if [string equal $key {}] {return [keylget listname]}
set keylist [keylget listname $key]
set uk [join "listname [split $key .]" ::]
if {[namespace children ::keylists::${uk}] == {}} {error "keyed list entry must be a two element list, found \"$keylist\""}
foreach keypair $keylist {
set kp [lindex $keypair 0]
lappend returnValue $kp
}
return $returnValue
}
proc keylset {uplistname args} {
if {([llength $args] < 2) || ([expr fmod([llength $args],2)] != 0)} {error "wrong # args: keylset listvar key value ?key value...?"}
upvar $uplistname listname
if {[info exists listname] && ![string equal $listname {}]} {
foreach keypair $listname {
if {[llength $keypair] != 2} {error "keyed list entry must be a two element list, found \"$keypair\""}
lappend listargs [lindex $keypair 0]
lappend listargs [lindex $keypair 1]
}
set args "$listargs $args"
}
if [namespace exists ::keylists::${uplistname}] {namespace delete ::keylists::${uplistname}}
foreach {key value} $args {
array unset queue
set key [join [split $key .] ::]
set queue($key) $value
while {![string equal [set currentKey [lindex [array names queue] 0]] {}]} {
namespace eval ::keylists::${uplistname}::${currentKey} {}
if {[llength [lindex $queue($currentKey) 0]] <= 1} {
namespace delete ::keylists::${uplistname}::${currentKey}
namespace eval ::keylists::${uplistname}::${currentKey} {}
set ::keylists::${uplistname}::${currentKey}::value [string map {\[ \x00} $queue($currentKey)]
array unset queue $currentKey
continue
}
foreach keypair $queue($currentKey) {
set key [lindex $keypair 0]
set key [join [split $key .] ::]
set value [lindex $keypair 1]
if {[llength [split [lindex $keypair 0] .]] > 1} {
set queue(${currentKey}::${key}) $value
array unset queue $currentKey
continue
}
if {[llength [lindex $queue($currentKey) 0]] > 1} {
set queue(${currentKey}::${key}) $value
} else {
namespace delete ::keylists::${uplistname}::${currentKey}
namespace eval ::keylists::${uplistname}::${currentKey} {}
set ::keylists::${uplistname}::${currentKey}::value [string map {\[ \x00} $value]
}
}
array unset queue $currentKey
}
}
lappend eachNamespace ::keylists::${uplistname}
lappend allNamespaces ::keylists::${uplistname}
while {[llength $eachNamespace] != 0} {
set allNamespaces [concat $allNamespaces [namespace children [lindex $eachNamespace 0]]]
set eachNamespace [concat $eachNamespace [namespace children [lindex $eachNamespace 0]]]
set eachNamespace [lrange $eachNamespace 1 end]
}
foreach ns $allNamespaces {
if ![info exists ${ns}::value] {
foreach child [namespace children $ns] {
append ${ns}::value "\[list \"\[list \"[string map "[list ${ns}::] {}" $child]\"] \[list \[set \"${child}::value\"]]\"] "
}
}
}
if ![info exists ::keylists::${uplistname}::value] {set ::keylists::${uplistname}::value {}}
while {![string equal [set ::keylists::${uplistname}::value] [subst -nobackslashes -novariables [set ::keylists::${uplistname}::value]]]} {
set ::keylists::${uplistname}::value [subst -nobackslashes -novariables [set ::keylists::${uplistname}::value]]
}
set listname [string trim [set ::keylists::${uplistname}::value]]
set listname [string map {\x00 \[} $listname]
return
}hv I often need to print out the whole keyed list, but there is no "keylprint" so here is my rough implementation:
proc keylprint {listvalues {indentationLevel 0} {indentString " "}} {
foreach key [keylkeys listvalues] {
set value [keylget listvalues $key]
puts -nonewline [string repeat $indentString $indentationLevel]
try_eval {
# Attempt to treat the value as a nested keyedlist
set subkeys [keylkeys listvalues $key]
set sublistvalues [keylget listvalues $key]
puts "$key:"
keylprint $sublistvalues [expr {$indentationLevel + 1}] $indentString
} {
# The value is not a nested keyedlist
puts "$key: $value"
}
}
}Example Usage:
keylset user unix.shell bash keylset user unix.alias haivu keylset user unix.home /home/haiv keylset user unix.workspace /workspaces/haivu keylset user windows.domain ACCOUNTING keylset user windows.workspace \\\\fileserver1\\workspaces\\haivu keylset user comp.vm144.ip 10.0.1.5 keylset user comp.vm144.version win7 keylset user comp.vm122.ip 10.0.1.6 keylset user comp.vm122.version winxp keylprint $user
Output:
unix:
shell: bash
alias: haivu
home: /home/haiv
workspace: /workspaces/haivu
windows:
domain: ACCOUNTING
workspace: \\fileserver1\workspaces\haivu
comp:
vm144:
ip: 10.0.1.5
version: win7
vm122:
ip: 10.0.1.6
version: winxp