[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.

----
[NEM] offers this simpler alternative version:

 # Use "2004" as our special exception code
 proc block {label args} {
     set rc [catch {uplevel 1 $args} ret]
     if {$rc == 2004 && $ret eq $label} { return }
     return -code $rc $ret
 }
 rename break __break
 proc break {args} {
     if {[llength $args] == 0} {
         return -code break
     } else {
         return -code 2004 [lindex $args 0]
     }
 }
And this version of the test code:
 set level0 "break label test"
 block label1 while 1 {
     puts "inside while 1"
     foreach - - {
         block label2 while 2 {
             puts "inside while 2"
             puts $level0
             puts "* breaking level 1"
             break label1
             error "should not happen 2"
         }
     }
     error "should not happen 1"
 }
 puts "back to level 0"