diff options
| author | oharboe <oharboe> | 2008-11-07 06:56:59 +0000 |
|---|---|---|
| committer | oharboe <oharboe> | 2008-11-07 06:56:59 +0000 |
| commit | 3fca2f6819789d79cb2b3df742e3b2231f21f756 (patch) | |
| tree | a887a6704b8a26b1342ab1b18f57dec2b2a2bfef | |
| parent | a7126d96a549cef31308687f38ed14738d711e74 (diff) | |
| download | jimtcl-3fca2f6819789d79cb2b3df742e3b2231f21f756.zip jimtcl-3fca2f6819789d79cb2b3df742e3b2231f21f756.tar.gz jimtcl-3fca2f6819789d79cb2b3df742e3b2231f21f756.tar.bz2 | |
2008-11-06 Steve Bennett <steveb@workware.net.au>
* jim-array-1.0.tcl: Add array command wrapper
2008-11-05 Steve Bennett <steveb@workware.net.au>
* jim-glob-1.0.tcl, jim-readdir.c: Add readdir extension and glob package for glob command
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | jim-array-1.0.tcl | 104 |
2 files changed, 112 insertions, 0 deletions
@@ -1,3 +1,11 @@ +2008-11-06 Steve Bennett <steveb@workware.net.au> + + * jim-array-1.0.tcl: Add array command wrapper + +2008-11-05 Steve Bennett <steveb@workware.net.au> + + * jim-glob-1.0.tcl, jim-readdir.c: Add readdir extension and glob package for glob command + 2008-11-05 Steve Bennett <steveb@workware.net.au> * jim-glob-1.0.tcl, jim-readdir.c: Add readdir extension and glob package for glob command diff --git a/jim-array-1.0.tcl b/jim-array-1.0.tcl new file mode 100644 index 0000000..a1298c0 --- /dev/null +++ b/jim-array-1.0.tcl @@ -0,0 +1,104 @@ +# (c) 2008 Steve Bennett <steveb@workware.net.au>
+#
+# Implements a Tcl-compatible array command based on dict
+#
+# The FreeBSD license
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. 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 JIM TCL PROJECT ``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
+# JIM TCL PROJECT 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.
+#
+# The views and conclusions contained in the software and documentation
+# are those of the authors and should not be interpreted as representing
+# official policies, either expressed or implied, of the Jim Tcl Project.
+
+package provide array 1.0
+
+proc array {subcmd arrayname args} {
+ # $name is the name of the array in the caller's context
+ upvar $arrayname name
+
+ if {$subcmd eq "exists"} {
+ return [info exists name]
+ }
+
+ if {![info exists name]} {
+ set name [dict create]
+ }
+
+ switch $subcmd {
+ set {
+ # The argument should be a list, but we also
+ # support name value pairs
+ if {[llength $args] == 1} {
+ set args [lindex $args 0]
+ }
+ foreach {key value} $args {
+ dict set name $key $value
+ }
+ return $name
+ }
+ size {
+ return [/ [llength $name] 2]
+ }
+ }
+
+ # The remaining options take a pattern
+ if {[llength $args] > 0} {
+ set pattern [lindex $args 0]
+ } else {
+ set pattern *
+ }
+
+ switch $subcmd {
+ names {
+ set keys {}
+ foreach {key value} $name {
+ if {[string match $pattern $key]} {
+ lappend keys $key
+ }
+ }
+ return $keys
+ }
+ get {
+ set list {}
+ foreach {key value} $name {
+ if {[string match $pattern $key]} {
+ lappend list $key $value
+ }
+ }
+ return $list
+ }
+ unset {
+ foreach {key value} $args {
+ if {[string match $pattern $key]} {
+ dict unset name $key
+ }
+ }
+ return
+ }
+ }
+
+ # Tcl-compatible error message
+ error "bad option \"$subcmd\": must be exists, get, names, set, size, or unset"
+}
|