unless is an alternative to if, as seen in Perl.
proc unless {condition body} {
uplevel [list if "!($condition)" $body]
}example:
unless {$tcl_version >= 8.4} {
error "package requires Tcl version 8.4 or greater"
}(NEM notes that package versions are not real numbers, you should use [package vcompare] for this)
Lars H: An alternative implementation, which avoids shimmering:
proc unless {condition body} {
uplevel 1 [list if $condition then {} else $body]
}glennj: additionally, provide an else clause...
proc unless {cond body args} {
set else_body {}
if {([llength $args] == 2) && ([lindex $args 0] eq "else")} {
set else_body [lindex $args 1]
} elseif {[llength $args] > 0} {
error "usage: [lindex [info level 0] 0] expr body1 ?else body2?"
}
uplevel 1 [list if $cond then $else_body else $body]
}The above implementations don't work if the command is break or continue; here's a more robust solution:
proc unless {expr command} {
global errorInfo errorCode
set code [catch {uplevel [list if $expr {} else $command]} result]
switch -exact -- $code {
0 {return $result}
1 {return -code error -errorinfo $errorInfo \
-errorcode $errorCode $result}
2 {return -code return $result}
3 {return -code break}
4 {return -code continue}
default {return -code $code $result}
}
}NEM offers this alternative version:
set ::TCL_ERROR [catch error]
proc unless {expr command} {
global errorInfo errorCode TCL_ERROR
set code [catch { uplevel 1 [list if $expr {} else $command] } result]
if {$code == $TCL_ERROR} {
return -code error -errorinfo $errorInfo \
-errorcode $errorCode $result
} else {
return -code $code $result
}
}i.e., using a global constant instead of hard-coding exception return codes and simplifying the switch (continue, return and break already set appropriate $result values). In 8.5 you can make use of extra options to catch and return:
package require Tcl 8.5
set ::TCL_ERROR [catch error]
proc unless {expr command} {
global errorCode errorInfo TCL_ERROR
set code [catch { uplevel 1 [list if $expr {} else $command] } result opts]
if {[dict get $opts -level] == 0} {
dict set opts -code $code
}
if {$code == $TCL_ERROR} {
dict set opts -errorcode $errorCode
dict set opts -errorinfo $errorInfo
}
dict incr opts -level
return {expand}$opts $result
}I think that works correctly, but it would be nice if someone more familiar with the new options could verify that that is how they are supposed to be used.