/usr/share/tcltk/tcllib1.19/dicttool/dicttool.tcl is in tcllib 1.19-dfsg-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 | ###
# This package enhances the stock dict implementation with some
# creature comforts
###
if {[info commands ::ladd] eq {}} {
proc ladd {varname args} {
upvar 1 $varname var
if ![info exists var] {
set var {}
}
foreach item $args {
if {$item in $var} continue
lappend var $item
}
return $var
}
}
if {[info command ::ldelete] eq {}} {
proc ::ldelete {varname args} {
upvar 1 $varname var
if ![info exists var] {
return
}
foreach item [lsort -unique $args] {
while {[set i [lsearch $var $item]]>=0} {
set var [lreplace $var $i $i]
}
}
return $var
}
}
if {[::info commands ::tcl::dict::getnull] eq {}} {
proc ::tcl::dict::getnull {dictionary args} {
if {[exists $dictionary {*}$args]} {
get $dictionary {*}$args
}
}
namespace ensemble configure dict -map [dict replace\
[namespace ensemble configure dict -map] getnull ::tcl::dict::getnull]
}
if {[::info commands ::tcl::dict::print] eq {}} {
###
# Test if element is a dict
###
proc ::tcl::dict::_putb {buffervar indent field value} {
::upvar 1 $buffervar buffer
::append buffer \n [::string repeat " " $indent] [::list $field] " "
if {[string index $field end] eq "/"} {
::incr indent 2
::append buffer "\{"
foreach item $value {
if [catch {
if {![is_dict $item]} {
::append buffer \n [::string repeat " " $indent] [list $item]
} else {
::append buffer \n "[::string repeat " " $indent]\{"
::incr indent 2
foreach {sf sv} $item {
_putb buffer $indent $sf $sv
}
::incr indent -2
::append buffer \n "[::string repeat " " $indent]\}"
}
} err] {
puts [list FAILED $indent $field $item]
puts $err
puts "$::errorInfo"
}
}
::incr indent -2
::append buffer \n [::string repeat " " $indent] "\}"
} elseif {[string index $field end] eq ":" || ![is_dict $value]} {
::append buffer [::list $value]
} else {
::incr indent 2
::append buffer "\{"
foreach {f v} $value {
_putb buffer $indent $f $v
}
::incr indent -2
::append buffer \n [::string repeat " " $indent] "\}"
}
}
proc ::tcl::dict::print dict {
::set buffer {}
::foreach {field value} $dict {
_putb buffer 0 $field $value
}
return $buffer
}
namespace ensemble configure dict -map [dict replace\
[namespace ensemble configure dict -map] print ::tcl::dict::print]
}
if {[::info commands ::tcl::dict::is_dict] eq {}} {
###
# Test if element is a dict
###
proc ::tcl::dict::is_dict { d } {
# is it a dict, or can it be treated like one?
if {[catch {dict size $d} err]} {
#::set ::errorInfo {}
return 0
}
return 1
}
namespace ensemble configure dict -map [dict replace\
[namespace ensemble configure dict -map] is_dict ::tcl::dict::is_dict]
}
if {[::info commands ::tcl::dict::rmerge] eq {}} {
###
# title: A recursive form of dict merge
# description:
# A routine to recursively dig through dicts and merge
# adapted from http://stevehavelka.com/tcl-dict-operation-nested-merge/
###
proc ::tcl::dict::rmerge {a args} {
::set result $a
# Merge b into a, and handle nested dicts appropriately
::foreach b $args {
for { k v } $b {
if {[string index $k end] eq ":"} {
# Element names that end in ":" are assumed to be literals
set result $k $v
} elseif { [dict exists $result $k] } {
# key exists in a and b? let's see if both values are dicts
# both are dicts, so merge the dicts
if { [is_dict [get $result $k]] && [is_dict $v] } {
set result $k [rmerge [get $result $k] $v]
} else {
set result $k $v
}
} else {
set result $k $v
}
}
}
return $result
}
namespace ensemble configure dict -map [dict replace\
[namespace ensemble configure dict -map] rmerge ::tcl::dict::rmerge]
}
if {[::info commands ::tcl::dict::isnull] eq {}} {
proc ::tcl::dict::isnull {dictionary args} {
if {![exists $dictionary {*}$args]} {return 1}
return [expr {[get $dictionary {*}$args] in {{} NULL null}}]
}
namespace ensemble configure dict -map [dict replace\
[namespace ensemble configure dict -map] isnull ::tcl::dict::isnull]
}
package provide dicttool 1.1
|