From 1cde3735df984ffb93be44bcb42af93c8f7d6847 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Sat, 4 Jan 2014 09:46:46 +1000
Subject: tclcompat: it is finally time to remove [case]

Use [switch] instead

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 tclcompat.tcl | 41 -----------------------------------------
 1 file changed, 41 deletions(-)

(limited to 'tclcompat.tcl')

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
-- 
cgit v1.1