Managing Exclusions in Plot[ ]

Question

When I do:

l = {5, 6, 6, 5, 6, 6, 5};
f = Interpolation@l;
g[t_] = D[f[t], t];
p1 = Plot[{f@x, g@x + 4}, {x, 1, Length@l}, Evaluated -> True,   Exclusions -> True]

I expect:

However, since Plot[] doesn't detect the discontinuities, I get:

I have two ways to overcome this, but none of them is robust enough.

The first one is excluding explicitly those points where the derivative changes a lot in a small interval. The problem here is that "a lot" and "small" are not defined clearly in my textbook.
Please note that Exclusions -> doesn't accept inequalities (well, it does, but only as an AND clause for equalities)

Off[InterpolatingFunction::dmval];
Plot[{f@x, g@x + 4}, {x, 1, Length@l}, 
      Exclusions -> {UnitStep[Abs[g[x] - g[x + .01]] - .5] == 1},
      Evaluated -> True]
On[InterpolatingFunction::dmval];

The second one displays the same problems.

Plot[{f@x, g[x] + 4}, {x, 1, 7}, Evaluated -> True] //. 
     Line[{a___, {x1_, y1_}, {x2_, y2_}, b___}] /; Abs[(y1 - y2)/(x1 - x2)] > 10 -> 
    {Line[{a, {x1, y1}}], Line[{{x2, y2}, b}]}

I tried a few things, including PlotPoints-> and MaxRecursion-> to no avail.
For example RegionFunction[] gives disappointing results and has the same drawbacks (I know this can be fixed, but the drawbacks remain):

Plot[{f@x, g@x + 4}, {x, 1, Length@l}, 
     RegionFunction -> Function[{x, y}, Abs[g[x] - g[x + .01]] < 0.05],
     Evaluated -> True]

So: Is there a better (ie. more robust and natural) way to manage the exclusions in these cases?

Credits

To Heike and Szabolcs for their unbelievable useful torn() and upload palette respectively.

Edit

Please note that the following is not what I want, since it requires previous knowledge of the function build up:

g[t_] = D[f[t], t];
Plot[{f@x, g[x] + 4}, {x, 1, Length@l}, Exclusions -> l, Evaluated -> True]

In any case it is irrelevant, since it doesn't work either

Edit 2

After a conversation with @Rojo about this, we (he) came up to the following interesting conclusion: Plot[] detects exclusions only when it can manipulate the functions symbolically. Just look at this:

iPN[x_?NumberQ] := IntegerPart[x];
Framed[GraphicsRow[Plot[#, {x, 0, 3}] & /@ {IntegerPart[x], iPN[x]}]]

Which by the way is strongly linked to my other question: What does “suitable for symbolic manipulation” in the documentation mean?

Moreover, you can see that Plot[] employs the same effort exploring the discontinuities for both functions, albeit the Exclusions results are different.

data = Reap[ Plot[ #, {x, 1, 7}, EvaluationMonitor :> Sow[{x, #}]] ][[-1,1]] & /@ 
                                                          {IntegerPart[x], iPN[x]};
p = Framed@GraphicsRow[ListPlot[#, Filling -> Axis] & /@ data]

Answer 1

You have

l = {5, 6, 6, 5, 6, 6, 5};
f = Interpolation@l;
g[t_] = D[f[t], t];
p1 = Plot[{f@x, g@x + 4}, {x, 1, Length@l}, Evaluated -> True, 
  Exclusions -> True]

and your plot

plot = Plot[{f@x, g[x] + 4}, {x, 1, 7}, Evaluated -> True];

I suggest

With[{multiplier = {AspectRatio, PlotRange} /. 
     AbsoluteOptions[plot, {AspectRatio, PlotRange}] /. {ar_, pl_} :> 
     ar Divide @@ Subtract @@@ Reverse /@ pl}, 
  (plot //. 
   Line[{a___, {x1_, y1_}, {x2_, y2_}, b___}] /; 
     Abs[(y1 - y2)/(x1 - x2)] > 10/multiplier :> {Line[{a, {x1, y1}}],
      Line[{{x2, y2}, b}]})
 ]

With your second suggestion, one gets the same resulting image

plot //. 
     Line[{a___, {x1_, y1_}, {x2_, y2_}, b___}] /; Abs[(y1 - y2)/(x1 - x2)] > 10 -> 
    {Line[{a, {x1, y1}}], Line[{{x2, y2}, b}]}

However it breaks by just changing the scales:

plot = Plot[1000. {f@x, g[x] + 4}, {x, 1, 7}, Evaluated -> True];

Incorporating the multiplyer, for this second example, one gets

Perhaps it would be smart to also add a condition not to filter vertical lines that are too short (relative to the plot range)