Return to Revisions

Here's a single function that does what you want:

ClearAll[Scope];
SetAttributes[Scope, HoldAll];

Scope[{globals : (_Symbol | _Set | _SetDelayed) ...}, body_] := 
Internal`InheritedBlock[{$ContextPath},
  (* Put globals into Global` or equivalent *)
  globals;
  Module[{context, localbody = MakeBoxes[body]},
    Internal`WithLocalSettings[
      BeginPackage[SymbolName@context <> "`"],
      ReleaseHold@MakeExpression@localbody,
      EndPackage[]
    ]
  ]
]

I'll detail more on how it works, later.

Using the example from Mr.Wizard,

x = 1;
y = 1;
Scope[{x = 2},
 Print[$ContextPath];
 y = 2;
 a = 0;
 Names["`*"]
]

{x, y, a}
(* {context$15569`,System`} *)
(* {"a", "y"} *)
(* {2, 1, a} *)

Unfortunately, it also produces shadowing messages for both y and a because they are first created within the global context, and then added to the local one. I have, yet, to work out how to prevent this.

Version 2

This version uses Block instead of moving everything to a separate context. To do so, it needs a couple of helper functions:

ClearAll[flatHold];
SetAttributes[flatHold, {Flat, HoldAll}];
{a__flatHold} ^:= flatHold[a]

which deals with nested Hold, and

ClearAll[getSymbols];
SetAttributes[getSymbols, HoldAllComplete];
getSymbols[(Set|SetDelayed|TagSet|TagSetDelayed)[a_Symbol,__]] := flatHold[a]
getSymbols[(Set|SetDelayed)[a_,_]] := 
 Cases[Unevaluated@a , 
  r_Symbol /; !MemberQ[Attributes[r], Protected|Locked|ReadProtected]:> flatHold[r], 
  {0, Infinity}, 1, Heads->True]

which gets the symbol that needs to be localized. The second form of getSymbols is as complicated as it is because of having to deal with SubValues, and the fact that Head@q[r][y] == q[r]. There is probably a better way, though. Unfortunately, it does not deal with UpSet or UpSetDelayed, which I leave as an exercise to whoever can come up with something.

With those, the new version of Scope becomes

ClearAll[Scope2];
SetAttributes[Scope2, HoldAll];

Scope2[{globals:(_Symbol | _Set|_SetDelayed)...}, body_]:=
Internal`InheritedBlock[{$ContextPath},
 (* Put globals into Global` or equivalent *)
 globals;

 With[{
  vars = Cases[
    Unevaluated@body, 
    s : _Set | _SetDelayed | _TagSet | _TagSetDelayed :> getSymbols[s], 
    Infinity] 
  },
  Quiet[
   Block[vars,body] /. flatHold[a__]:> Unevaluated[{a}], 
   Block::lvlist
  ]
 ]
]

x = 1;
y = 1;
Scope2[{x = 2},
 q[x_] := x^2;
 r /: q[r] := 5;
 {y = 2, a = 0, q[2], q[r]}
]

{x, y, a, r}
DownValues[q]
UpValues[r]
(* 
 {2, 0, 4, 5}
 {2, 1, a, r}
 {}
 {}
*)