Posted to tcl by aku at Mon Jul 21 20:00:45 GMT 2008view pretty

## -*- tcl -*-
# ### ### ### ######### ######### #########
## Support code

proc sd {} {
    set levels [info frame]
    set n 0
    puts "-- ---"
    while {$levels > 0} {
	puts "-- ... [info frame $n]"
	incr n -1
	incr levels -1
    }
    puts "-- ---"
    return
}

# ### ### ### ######### ######### #########

proc control {vv script} {
    upvar 1 $vv var
    set var calling
    set     x [uplevel 1 $script]
    append  x /$var
    return $x
}

# ### ### ### ######### ######### #########

proc datal {} {
    puts [control y {
	set y PPL
	puts "$y [sd]"
    }]
    return
}

proc datav {} {
    set script {
	set y PPV
	puts "$y [sd]"
    }

    puts [control y $script]
    return
}

# ### ### ### ######### ######### #########
## 6 use cases.

puts "## DV. direct-var ##"
puts "## DL. direct-literal ##"
puts "## DPV direct-proc-var ##"
puts "## DPL direct-proc-literal ##"
puts "## PPV proc-proc-var ##"
puts "## PPL proc-proc-literal ##"
puts "# ### ### ### ######### ######### #########"

puts "## DV. direct-var ##"
set script {
    set y DV.
    puts "$y [sd]"
}
puts [uplevel \#0 $script]

puts "## DL  direct-literal ##"
puts [uplevel \#0 {
    set y DL.
    puts "$y [sd]"
}]

puts "## DPV direct-proc-var ##"
set script {
    set y DPV
    puts "$y [sd]"
}
puts [control y $script]

puts "## DPL direct-proc-literal ##"
puts [control y {
    set y DPL
    puts "$y [sd]"
}]

puts "## PPV proc-proc-var ##"
datav

puts "## PPL proc-proc-literal ##"
datal