Posted to tcl by ro at Thu Sep 03 19:17:35 GMT 2009view raw
- proc limited_while {cond body {limit 10}} {
- set n 0
- while 1 {
- if {$n == $limit} {
- return -code error "hit limit of $n loops"
- }
- puts "----"
- puts "cond => $cond"
- set cond_value [uplevel [list expr $cond]]
- puts "cond_value => $cond_value"
- if {!$cond_value} return
- catch {uplevel $body} xres xopt
- puts "xres => $xres"
- puts "xopt => $xopt"
- set code [dict get $xopt -code]
- puts "code => $code"
- if {$code == 3} {
- uplevel [list return -options $xopt -code break $xres]
- #uplevel [list return -code break]
- #break
- }
- incr n
- }
- return
- }
- set n 0
- limited_while {$n < 25} {
- puts "the value of n is $n"
- if {$n == 1} break
- incr n
- }