A tiny framework to cure the leaks of lexical scoping in Mathematica

AutoRenamings

ClearAll[getPatternSymbols, getDeclaredSymbols];
SetAttributes[{getPatternSymbols, getDeclaredSymbols}, HoldAll];
getPatternSymbols[expr_] :=
  Cases[Unevaluated[expr], 
   Verbatim[Pattern][ss_, _] :> HoldComplete[ss], {0, Infinity}, 
   Heads -> True];

getDeclaredSymbols[{decs___}] :=
  Thread@Replace[HoldComplete[{decs}], 
    HoldPattern[a_ = rhs_] :> a, {2}];


ClearAll[renamingRules];
renamingRules[symbs : {___HoldComplete}] :=
 MapThread[
  Rule,
  symbs /.
   {{HoldComplete[s_] :> HoldPattern[s]},
    {HoldComplete[s_] :> Unique[Unevaluated[s]]}}]


ClearAll[myHold];
SetAttributes[myHold, HoldAllComplete];


ClearAll[makeRenamings];
SetAttributes[makeRenamings, HoldAll];
makeRenamings[expr : (_myHold | _Pattern)] := expr;

makeRenamings[SetDelayed[lhs_, rhs_]] :=
  ReplaceAll[#, renamingRules[getPatternSymbols[#]]] &@
   Apply[myHold[SetDelayed[##]] &, {makeRenamings[lhs], 
     makeRenamings[rhs]}];

makeRenamings[Function[x_Symbol, body_]] := 
  makeRenamings[Function[{x}, body]];

makeRenamings[(head : With | Function | Module)[decl_, body_, 
    atts_: Automatic]] :=
  With[{rules = renamingRules@getDeclaredSymbols[decl]},
   Apply[myHold[head[#1, #2]] &,
     {makeRenamings[decl],
      makeRenamings[body],
      If[atts === Automatic, Sequence @@ {}, atts]}] /. rules];

makeRenamings[f_[elems___]] :=
  makeRenamings[f] @@ Map[makeRenamings, Unevaluated[{elems}]];

makeRenamings[a_ /; AtomQ[Unevaluated[a]]] := myHold[a]

makeRenamings[expr_, Full] :=
 Hold[Evaluate[makeRenamings[expr]]] //. myHold[x_] :> x


ClearAll[runWithRenamings];
SetAttributes[runWithRenamings, HoldAll];
runWithRenamings[code_] :=
  ReleaseHold@makeRenamings[code, Full];


ClearAll[enableAutoRenamings, disableAutoRenamings, $inSetDelayed];
enableAutoRenamings[] :=
  Module[{},
   Unprotect[SetDelayed];
   s_SetDelayed /; ! TrueQ[$inSetDelayed] :=
    Block[{$inSetDelayed = True},
     runWithRenamings[s]];
   Protect[SetDelayed];
   ];

disableAutoRenamings[] :=
  Module[{},
   Unprotect[SetDelayed];
   DownValues[SetDelayed] = 
    DeleteCases[DownValues[SetDelayed] ,
     def_ /; ! FreeQ[def, $inSetDelayed ]]
   ];

AutoRenamingsTests

makeRenamings[
 ClearAll[f, g];
 f[x_] := g[With[{a = #}, x] &];
 g[fn_] := Module[{h}, h[a_] := fn[a]; h[0]];,
 Full
 ]

enableAutoRenamings[]

ClearAll[f, g];
f[x_] := g[With[{a = #}, x] &];
g[fn_] := Module[{h}, h[a_] := fn[a]; h[0]];

?f

?g

f[999]

disableAutoRenamings[]

ClearAll[f, g];
f[x_] := g[With[{a = #}, x] &];
g[fn_] := Module[{h}, h[a_] := fn[a]; h[0]];
f[999]