ulis: The gotos are gone but we still need to gracefully break out of an erroneous sequence. So we have the 'break'.
The pitfall with 'break' is that we can only break out of the current block.
Here is a mechanism for breaking out of named blocks.
The gotos are gone (except for GOTO in Tcl) but the labels come back.
On a structured manner, indeed.
Usage:
defining an anonymous block
: - block
defining a named block
: label block
breaking out of this named block
break label
remark: all blocks must be linked, so define anonymous blocks if needed between named blocks.
# the break command
proc break {{label ""}} \
{
if {$label != ""} \
{
# check for existance
if {![info exists ::break::$label]} \
{ error "unknown label \"$label\"" }
# set break flag
set ::break::break 1
# set stopping label
set ::break::$label 1
}
# do break
return -code break
}
# the label (:) command
proc : {label args} \
{
# if named, create namespace, create our label
if {$label != "-"} \
{ namespace eval ::break set $label 0 }
# execute
set rc [catch { uplevel 1 $args } rs]
# get state of our label and clean-up
if {$label == "-"} { set flag 0 } \
else \
{
set flag [set ::break::$label]
unset ::break::$label
}
# break mechanism
if {[info exists ::break::break]} \
{
if {$flag} \
{ # stop breaking here
unset ::break::break
} \
elseif {$rc == 0} \
{ # continue breaking
return -code break
}
}
# return return event
global errorInfo errorCode
return -code $rc -errorinfo $errorInfo -errorcode $errorCode $rs
}The test
catch { console show }
set level0 "break label test"
: label1 \
while 1 \
{
puts "inside while 1"
: - \
foreach - - \
{
# inside anonymous foreach
: label2 \
while 2 \
{
puts "inside while 2"
puts $level0
puts "* breaking while 1"
break label1
error "should not happen 2"
}
}
error "should not happen 1"
}
puts "back to level 0"The result
inside level 1 inside level 2 break label test * breaking level 1 back to level 0
With that you can still use 'break' or 'return -code break'.
You can also break out of any named block.
A fine extension would be to break out of a named script:
In proc : replace:
# execute
set rc [catch { uplevel 1 $args } rs]by
# execute
set block [lindex $args 0]
switch -exact -- $block \
{
while - for - foreach \
{ set rc [catch { uplevel 1 $args } rs] }
default
{ set rc [catch { uplevel 1 foreach - - $args } rs] }
}The dummy foreach will allow for break inside the script.