Promote now swaps focused window with master window

This means other windows are unaffected.
The change from the previous cycling behaviour was felt necessary, since
cycling isn't a terribly useful operation.

Some properties that hold:
    focus is unchanged by promotion
    promote is idempotent (promoting twice does nothing)
    the focused and master window will swap their positions in the stack

darcs-hash:20070418224236-9c5c1-4539f9f397e181f91dc9743e3ffac4b5796c0fac

3 files changed, 37 insertions, 9 deletions

diff --git a/Operations.hs b/Operations.hs
index 418d4ea..0effd8d 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -91,9 +91,6 @@ flipRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
 -- tiling mode, the currently focused window becomes a master. When
 -- switching back , the focused window is uppermost.
 --
--- Note a current `feature' is that 'promote' cycles clockwise in Tall
--- mode, and counter clockwise in wide mode. This is a feature.
---
 switchLayout :: X ()
 switchLayout = layout $ \fl -> fl { layoutType = rotateLayout (layoutType fl) }
 
@@ -224,7 +221,7 @@ setBorder w p = withDisplay $ \d -> io $ setWindowBorder d w p
 raise :: Ordering -> X ()
 raise = windows . W.rotate
 
--- | promote. Cycle the current tiling order clockwise.
+-- | promote. Move the currently focused window into the master frame
 promote :: X ()
 promote = windows W.promote
 
diff --git a/StackSet.hs b/StackSet.hs
index 89a8484..a7bc376 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -24,7 +24,7 @@
 module StackSet where
 
 import Data.Maybe
-import qualified Data.List     as L (delete,genericLength)
+import qualified Data.List     as L (delete,genericLength,elemIndex)
 import qualified Data.Map      as M
 
 ------------------------------------------------------------------------
@@ -216,12 +216,35 @@ raiseFocus k w = case M.lookup k (cache w) of
     Nothing -> w
     Just i  -> (view i w) { focus = M.insert i k (focus w) }
 
--- | Cycle the current stack ordering. In tiled mode has the effect of
--- moving a new window into the master position, without changing focus.
-promote :: StackSet a -> StackSet a
+-- | Swap the currently focused window with the master window (the
+-- window on top of the stack). Focus moves to the master.
+promote :: Ord a => StackSet a -> StackSet a
+promote w = maybe w id $ do
+    a <- peek w -- fail if null
+    let w' = w { stacks = M.adjust (\s -> swap a (head s) s) (current w) (stacks w) }
+    return $ insert a (current w) w' -- and maintain focus
+
+--
+-- | Swap first occurences of 'a' and 'b' in list.
+-- If both elements are not in the list, the list is unchanged.
+--
+swap :: Eq a => a -> a -> [a] -> [a]
+swap a b xs
+    | a == b                    = xs    -- do nothing
+    | Just ai <- L.elemIndex a xs
+    , Just bi <- L.elemIndex b xs = insertAt bi a (insertAt ai b xs)
+ where
+    insertAt n x ys = as ++ x : tail bs
+        where (as,bs) = splitAt n ys
+
+swap _ _ xs = xs -- do nothing
+
+{-
+-- cycling:
 promote w = w { stacks = M.adjust next (current w) (stacks w) }
    where next [] = []
          next xs = last xs : init xs
+-}
 
 -- |
 elemAfter :: Eq a => a -> [a] -> Maybe a
diff --git a/tests/Properties.hs b/tests/Properties.hs
index 1d464a7..245f02f 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -6,7 +6,7 @@ import Data.Maybe
 import System.Environment
 import Control.Exception    (assert)
 import Control.Monad
-import Test.QuickCheck
+import Test.QuickCheck hiding (promote)
 import System.IO
 import System.Random
 import Text.Printf
@@ -104,6 +104,12 @@ prop_screenworkspace x = all test [0..((fromIntegral $ size x)-1)]
                         Just sc -> workspace sc x == Just ws
           _ = x :: T
 
+prop_promote2 x = promote (promote x) == (promote x)
+  where _ = x :: T
+
+prop_promotefocus x = focus (promote x) == focus x -- focus doesn't change
+  where _ = x :: T
+
 ------------------------------------------------------------------------
 
 main :: IO ()
@@ -131,6 +137,8 @@ main = do
         ,("currentwsvisible ", mytest prop_currentwsvisible)
         ,("ws screen mapping", mytest prop_ws2screen_screen2ws)
         ,("screen/workspace ", mytest prop_screenworkspace)
+        ,("promote idempotent", mytest prop_promote2)
+        ,("promote/focus",     mytest prop_promotefocus)
         ]
 
 debug = False