Posted to tcl by evilotto at Fri Mar 14 17:50:15 GMT 2014view raw

  1. proc locals {args} {
  2. foreach vn $args {
  3. uplevel upvar 0 __locals($vn) $vn
  4. }
  5. }
  6.  
  7. proc nonlocals {args} {
  8. foreach vn $args {
  9. if {[string match __* $vn]} continue
  10. uplevel upvar 2 $vn $vn
  11. }
  12. }
  13.  
  14. proc scope {script} {
  15. set v [uplevel info vars]
  16. set vb "nonlocals $v\n"
  17. apply [list {} $vb$script]
  18. }
  19.  
  20. proc scoped {cmd args} {
  21. switch $cmd {
  22. if {
  23. lassign $args expr body
  24. uplevel if $expr [list [list scope $body]]
  25. }
  26. while {
  27. lassign $args test body
  28. uplevel while $test [list [list scope $body]]
  29. }
  30. foreach {
  31. set body [lindex $args end]
  32. set cmd [lreplace $args end end [list [list scope $body]]]
  33. uplevel foreach {*}$cmd
  34. }
  35. default {error "$cmd unsupported"}
  36. }
  37. }
  38.  
  39. set a 1
  40. if {true} {
  41. set b 1
  42. }
  43. puts "b=$b"
  44. scoped if {true} {
  45. nonlocals b c d
  46. set c 1
  47. set b 2
  48. puts "c=$c b=$b"
  49. }
  50. puts "b=$b"
  51. puts "c=$c b=$b"
  52. puts "d=$d"
  53.  
  54.  
  55. set l {1 2 3}
  56. foreach x $l {
  57. puts $x
  58. set a $l
  59. }
  60. puts $a
  61. unset a
  62.