[Keith Vetter] 2018-08-15: Another tip I think would be great if implemented is https://core.tcl.tk/tips/doc/trunk/tip/508.md%|%Tip 508 New subcommand [[array default]]%|%. Here's a tcl-only implementation of a new array default subcommand. It uses traces to track whether or not the default value needs to be used. Also included is a snippet to install the new command into the array ensemble. So you can type '''array default set myArr myValue''' just as the tip specifies. ====== ##+########################################################################## # # Tcl only implementation of tip 508 -- array default command # See tip 508: https://core.tcl-lang.org/tips/doc/trunk/tip/508.md # by Keith Vetter 2018-08-15 # # Add our command into the array ensemble namespace ensemble configure array -map \ [dict merge [namespace ensemble configure array -map] \ {default DefaultArray}] proc DefaultArray {option arrayName args} { if {$option ni {get set exists unset}} { error "bad option $option: must be get, set, exists, or unset" } upvar 1 $arrayName $arrayName if {[info exists $arrayName] && ! [array exists $arrayName]} { error "$arrayName is not an array" } if {$option eq "set"} { lassign $args value array set $arrayName {} # Remove any existing default values foreach tr [trace info variable $arrayName] { if {[string first "META: default:" $tr] > -1} { eval trace remove variable $arrayName $tr } } trace add variable $arrayName read [list apply [list {v1 v2 op} " # META: default: $value upvar 1 \$v1 \$v1 set exists \[info exists \$v1\\\(\$v2)\] if {! \$exists} { array set \$v1 \[list \$v2 $value\] } "]] return } if {$option eq "get"} { if {! [array exists $arrayName]} { error "$arrayName is not an array" } set t [trace info variable $arrayName] if {$t eq ""} { error "$arrayName has no default value" } set n [regexp -line {META: default: (.*)$} $t . value] if {! $n} { error "internal error: no meta data" } return $value } if {$option eq "exists"} { if {! [array exists $arrayName]} { return 0 } set t [trace info variable $arrayName] set n [regexp -line {META: default: (.*)$} $t . value] if {! $n} { return 0 } return 1 } if {$option eq "unset"} { if {! [array exists $arrayName]} { return } foreach tr [trace info variable $arrayName] { if {[string first "META: default:" $tr] > -1} { eval trace remove variable $arrayName $tr } } return } } ====== Here's some code to show test this command ====== proc Show {varName cmd expected} { upvar 1 $varName $varName set actual [{*}$cmd] if {$actual eq $expected} { puts "ok : $cmd => $actual" } else { puts "bad : $cmd => $actual :: wanted $expected" } } puts "Testing at the global level" Show A {array default exists A} 0 Show A {array default exists A} 0 Show A {catch {set A(3)}} 1 Show A {array default set A KPV} "" Show A {set A(3)} KPV Show A {set A(4) "xyz"} xyz Show A {set A(4)} xyz Show A {array default exists A} 1 Show A {array default unset A} "" Show A {array default exists A} 0 Show A {set A(3)} KPV Show A {catch {set A(5)}} 1 proc myProc {} { puts "\nTesting inside a procedure" Show AA {array default exists AA} 0 Show AA {array default exists AA} 0 Show AA {catch {set AA(3)}} 1 Show AA {array default set AA KPV} "" Show AA {set AA(3)} KPV Show AA {set AA(4) "xyz"} xyz Show AA {set AA(4)} xyz Show AA {array default exists AA} 1 Show AA {array default unset AA} "" Show AA {array default exists AA} 0 Show AA {set AA(3)} KPV Show AA {catch {set AA(5)}} 1 } myProc ====== <>Enter Category Here