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