diff options
author | Steve Bennett <steveb@workware.net.au> | 2014-01-04 09:46:46 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2014-01-15 07:15:24 +1000 |
commit | 1cde3735df984ffb93be44bcb42af93c8f7d6847 (patch) | |
tree | 2772082ff60ba7e52020c4634ec875f74665a6a4 /tclcompat.tcl | |
parent | 37cf9b17a7d0920625550fe9f7a7d64904c6d23a (diff) | |
download | jimtcl-1cde3735df984ffb93be44bcb42af93c8f7d6847.zip jimtcl-1cde3735df984ffb93be44bcb42af93c8f7d6847.tar.gz jimtcl-1cde3735df984ffb93be44bcb42af93c8f7d6847.tar.bz2 |
tclcompat: it is finally time to remove [case]
Use [switch] instead
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'tclcompat.tcl')
-rw-r--r-- | tclcompat.tcl | 41 |
1 files changed, 0 insertions, 41 deletions
diff --git a/tclcompat.tcl b/tclcompat.tcl index b2e8139..84d9d25 100644 --- a/tclcompat.tcl +++ b/tclcompat.tcl @@ -56,47 +56,6 @@ if {[info commands stdout] ne ""} { } } -# case var ?in? pattern action ?pattern action ...? -proc case {var args} { - # Skip dummy parameter - if {[lindex $args 0] eq "in"} { - set args [lrange $args 1 end] - } - - # Check for single arg form - if {[llength $args] == 1} { - set args [lindex $args 0] - } - - # Check for odd number of args - if {[llength $args] % 2 != 0} { - return -code error "extra case pattern with no body" - } - - # Internal function to match a value agains a list of patterns - local proc case.checker {value pattern} { - string match $pattern $value - } - - foreach {value action} $args { - if {$value eq "default"} { - set do_action $action - continue - } elseif {[lsearch -bool -command case.checker $value $var]} { - set do_action $action - break - } - } - - if {[info exists do_action]} { - set rc [catch [list uplevel 1 $do_action] result opts] - if {$rc} { - incr opts(-level) - } - return {*}$opts $result - } -} - # fileevent isn't needed in Jim, but provide it for compatibility proc fileevent {args} { tailcall {*}$args |