diff options
| -rw-r--r-- | Operations.hs | 5 | ||||
| -rw-r--r-- | StackSet.hs | 31 | ||||
| -rw-r--r-- | tests/Properties.hs | 10 |
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 |