Tcl Source Code

Artifact 92b38153db7fc388264995c275d974b145f97be3:

#! /bin/env tclsh

if {[namespace which [namespace current]::for_global] eq {}} {
	rename ::for for_global
	if {[namespace current] ne "::"} {
		interp alias {} ::for {} [namespace current]::for
	}
}

proc for args {
	if {[lindex $args 1] eq "in"} {
		if {[llength $args] % 3 != 1} {
			return -code error "wrong # of arguments"
		}
		set iters [dict create]
		set vars [dict create]
		while {[llength $args] > 1} {
			set args [lassign $args[unset args] varnames /dev/null iter]
			if {$iter ne {} && [uplevel [::list namespace which $iter]] eq {}} {
				return -code error "no such iterator: $iter.  Maybe \[foreach] was intended?"
			}
			dict set iters $iter 1 
			dict set vars $varnames $iter
		}
		set body [lindex $args[set args {}] 0]
		while {[dict size $iters]} {
			set newvals[set newvals {}] [dict create]
			dict for {varnames iter} $vars {
				foreach varname $varnames {
					if {[namespace which $iter] eq {}} {
						dict set newvals $varname {}
					} else {
						dict set newvals $varname [uplevel [list $iter]]
						if {[namespace which $iter] eq {}} {
							dict unset iters $iter
							dict set newvals $varname {}
						}
					}
				}
			}
			if {[dict size $iters]} {
				dict for {varname val} $newvals {
					uplevel [list variable $varname $val]
				}
				set code [catch {uplevel $body} result]
				switch -exact -- $code {
					0 {}
					1 {
					return  -errorcode $::errorCode -code error $result
					}
					3 {
					# FRINK: nocheck
					return
					}
					4 {}
					default {
					return -code $code $result
					}
				}
			} else {
				break
			}
		}
	} else {
		uplevel [list [namespace current]::for_global {*}$args]
	}
}

proc iterdir {path} {
	variable uniqueid
	set subdirs [list $path]
	coroutine [incr uniqueid] apply { path {
		set yield [yield [info coroutine]]
		foreach item [glob -nocomplain -directory $path *] {
			if {[file isdirectory $item]} {
				for item in [iterdir $item] {
					yield $item
				}
			} else {
				yield $item
			}
		}
	}} $path
}

variable uniqueid 0

set tempdir [file mkdir zook1]
file mkdir [set tmpa [file join $tempdir tmpa]]

set res [list]
for item in [iterdir $tempdir] {
	lappend res [string range $item [string length $tempdir] end]
}
puts $res