Commits

Taylor Venable committed 5a39a74

Add a library to enhance the [dict] command

Comments (0)

Files changed (1)

+### Copyright (c) 2014, Taylor Venable
+### All rights reserved.
+###
+### Redistribution and use in source and binary forms, with or without
+### modification, are permitted provided that the following conditions are met:
+###
+###     * Redistributions of source code must retain the above copyright
+###       notice, this list of conditions and the following disclaimer.
+###
+###     * Redistributions in binary form must reproduce the above copyright
+###       notice, this list of conditions and the following disclaimer in the
+###       documentation and/or other materials provided with the distribution.
+###
+### THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+### AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+### ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+### INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+### CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+### ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+### POSSIBILITY OF SUCH DAMAGE.
+
+package provide tcv::dict 1.0
+
+package require tcv::eproc 1.1
+
+namespace eval ::tcv::dict {
+    rename ::dict ::tcv::dict::Original
+    namespace ensemble create -command ::dict -subcommands {get load} -unknown ::tcv::dict::OriginalWrapper
+
+    proc OriginalWrapper {_ args} {
+        return [list [namespace current]::Original [lindex $args 0]]
+    }
+
+    ::tcv::eproc load {
+        args {varName dictVal}
+        rest keys
+    } {
+        if {[uplevel info exists $varName]} {
+            uplevel unset $varName
+        }
+
+        if {[Original exists $dictVal {*}$keys]} {
+            uplevel [list set $varName [Original get $dictVal {*}$keys]]
+        }
+    }
+
+    ::tcv::eproc get {
+        opts {-default}
+        args {dictval}
+        rest keys
+    } {
+        if {[info exists default] && ![Original exists $dictval {*}$keys]} {
+            return $default
+        } else {
+            return [Original get $dictval {*}$keys]
+        }
+    }
+}