twin/xmonad
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad.git synced 2025-05-19 08:30:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Add mapLayout

Browse Source
This commit is contained in:
Spencer Janssen 2007-10-04 23:45:37 +00:00
parent 65f3f4db8a
commit 42b691d515
2 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
StackSet.hs
View File

@ -25,8 +25,8 @@ module StackSet (
-- * Operations on the current stack -- * Operations on the current stack
-- $stackOperations -- $stackOperations
peek, index, integrate, integrate', differentiate, peek, index, integrate, integrate', differentiate,
focusUp, focusDown, focusMaster, focusUp, focusDown, focusMaster, focusWindow,
focusWindow, tagMember, renameTag, ensureTags, member, findIndex, tagMember, renameTag, ensureTags, member, findIndex, mapLayout,
-- * Modifying the stackset -- * Modifying the stackset
-- $modifyStackset -- $modifyStackset
insertUp, delete, delete', filter, insertUp, delete, delete', filter,
@ -424,6 +424,12 @@ ensureTags l allt st = et allt (map tag (workspaces st) \\ allt) st
et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s }) et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s })
et (i:is) (r:rs) s = et is rs $ renameTag r i s et (i:is) (r:rs) s = et is rs $ renameTag r i s
mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd
mapLayout f (StackSet v vs hs m) = StackSet (fScreen v) (map fScreen vs) (map fWorkspace hs) m
where
fScreen (Screen ws s sd) = Screen (fWorkspace ws) s sd
fWorkspace (Workspace t l s) = Workspace t (f l) s
-- | /O(n)/. Is a window in the StackSet. -- | /O(n)/. Is a window in the StackSet.
member :: Eq a => a -> StackSet i l a s sd -> Bool member :: Eq a => a -> StackSet i l a s sd -> Bool
member a s = maybe False (const True) (findIndex a s) member a s = maybe False (const True) (findIndex a s)

7
tests/Properties.hs
View File

@ -602,6 +602,10 @@ prop_rename1 (x::T) o n = o `tagMember` x && not (n `tagMember` x) ==>
prop_ensure (x :: T) l xs = let y = ensureTags l xs x prop_ensure (x :: T) l xs = let y = ensureTags l xs x
in and [ n `tagMember` y | n <- xs ] in and [ n `tagMember` y | n <- xs ]
prop_mapLayoutId (x::T) = x == mapLayout id x
prop_mapLayoutInverse (x::T) = x == mapLayout pred (mapLayout succ x)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- some properties for layouts: -- some properties for layouts:
@ -740,6 +744,9 @@ main = do
,("renaming works", mytest prop_rename1) ,("renaming works", mytest prop_rename1)
,("ensure works", mytest prop_ensure) ,("ensure works", mytest prop_ensure)
,("mapLayout id", mytest prop_mapLayoutId)
,("mapLayout inverse", mytest prop_mapLayoutInverse)
-- testing for failure: -- testing for failure:
,("abort fails", mytest prop_abort) ,("abort fails", mytest prop_abort)
,("new fails with abort", mytest prop_new_abort) ,("new fails with abort", mytest prop_new_abort)