summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Operations.hs5
-rw-r--r--StackSet.hs31
-rw-r--r--tests/Properties.hs10
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