Lists' intersection keeping elements' order

I could use the function Intersection, but it returns a sorted list. That's why I have to do my own, but it looks too big. I hope it could be done shorter.

lists = {{1, 2, 3, 4, 5}, {1, 2, 3, 4}, {2, 3, 4, 5}};
Fold[ Function[ {a, b},
  Select[b, MemberQ[a, #] &]
  ], lists // First, lists // Rest]

This function deletes from the first list all the elements not contained in the intersection, thus returning what you want:

f[l_List]:= DeleteCases[First@l, Except[Alternatives @@ (Intersection @@ l)]]  

f[{{1, 2, 3, 4, 5}, {1, 2, 3, 4}, {2, 3, 4, 5}}]  
->{2,3,4}

f[{{5, 7, 6, 3}, {5, 6, 1, 3}}]
->{5,6,3}

StackExchange Code Review Q#1858, answer score: 3