Add greedyView, make it the default action for mod-wer

This commit is contained in:
Spencer Janssen
2007-08-15 02:55:04 +00:00
parent 8bb313ea53
commit 2f3ccd7ab6
3 changed files with 57 additions and 2 deletions

View File

@@ -92,7 +92,7 @@ shift n = windows (W.shift n)
-- | view. Change the current workspace to workspace at offset n (0 indexed). -- | view. Change the current workspace to workspace at offset n (0 indexed).
view :: WorkspaceId -> X () view :: WorkspaceId -> X ()
view = windows . W.view view = windows . W.greedyView
-- | Modify the size of the status gap at the top of the current screen -- | Modify the size of the status gap at the top of the current screen
-- Taking a function giving the current screen, and current geometry. -- Taking a function giving the current screen, and current geometry.

View File

@@ -15,7 +15,7 @@ module StackSet (
StackSet(..), Workspace(..), Screen(..), StackOrNot, Stack(..), RationalRect(..), StackSet(..), Workspace(..), Screen(..), StackOrNot, Stack(..), RationalRect(..),
-- * Construction -- * Construction
-- $construction -- $construction
new, view, new, view, greedyView,
-- * Xinerama operations -- * Xinerama operations
-- $xinerama -- $xinerama
lookupWorkspace, lookupWorkspace,
@@ -244,6 +244,25 @@ view i s
-- 'Catch'ing this might be hard. Relies on monotonically increasing -- 'Catch'ing this might be hard. Relies on monotonically increasing
-- workspace tags defined in 'new' -- workspace tags defined in 'new'
-- |
-- Set focus to the given workspace. If that workspace does not exist
-- in the stackset, the original workspace is returned. If that workspace is
-- 'hidden', then display that workspace on the current screen, and move the
-- current workspace to 'hidden'. If that workspace is 'visible' on another
-- screen, the workspaces of the current screen and the other screen are
-- swapped.
greedyView :: (Eq a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd
greedyView w ws
| any wTag (hidden ws) = view w ws
| (Just s) <- L.find (wTag . workspace) (visible ws)
= ws { current = (current ws) { workspace = workspace s }
, visible = s { workspace = workspace (current ws) }
: L.filter (not . wTag . workspace) (visible ws) }
| otherwise = ws
where
wTag = (w == ) . tag
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- $xinerama -- $xinerama

View File

@@ -136,6 +136,9 @@ prop_empty_I (n :: Positive Int) = forAll (choose (1,fromIntegral n)) $ \m ->
prop_view_I (n :: NonNegative Int) (x :: T) = prop_view_I (n :: NonNegative Int) (x :: T) =
n `tagMember` x ==> invariant $ view (fromIntegral n) x n `tagMember` x ==> invariant $ view (fromIntegral n) x
prop_greedyView_I (n :: NonNegative Int) (x :: T) =
n `tagMember` x ==> invariant $ view (fromIntegral n) x
prop_focusUp_I (n :: NonNegative Int) (x :: T) = prop_focusUp_I (n :: NonNegative Int) (x :: T) =
invariant $ foldr (const focusUp) x [1..n] invariant $ foldr (const focusUp) x [1..n]
prop_focusDown_I (n :: NonNegative Int) (x :: T) = prop_focusDown_I (n :: NonNegative Int) (x :: T) =
@@ -217,6 +220,33 @@ prop_view_reversible (i :: NonNegative Int) (x :: T) =
i `tagMember` x ==> normal (view n (view i x)) == normal x i `tagMember` x ==> normal (view n (view i x)) == normal x
where n = tag (workspace $ current x) where n = tag (workspace $ current x)
-- ---------------------------------------------------------------------
-- greedyViewing workspaces
-- greedyView sets the current workspace to 'n'
prop_greedyView_current (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
tag (workspace $ current (greedyView i x)) == i
where
i = fromIntegral n
-- greedyView *only* sets the current workspace, and touches Xinerama.
-- no workspace contents will be changed.
prop_greedyView_local (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
workspaces x == workspaces (greedyView i x)
where
workspaces a = sortBy (\s t -> tag s `compare` tag t) $
workspace (current a)
: map workspace (visible a) ++ hidden a
i = fromIntegral n
-- greedyView is idempotent
prop_greedyView_idem (x :: T) (i :: NonNegative Int) = i `tagMember` x ==> greedyView i (greedyView i x) == (greedyView i x)
-- greedyView is reversible, though shuffles the order of hidden/visible
prop_greedyView_reversible (i :: NonNegative Int) (x :: T) =
i `tagMember` x ==> normal (greedyView n (greedyView i x)) == normal x
where n = tag (workspace $ current x)
-- normalise workspace list -- normalise workspace list
normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) } normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) }
where where
@@ -518,6 +548,12 @@ main = do
-- ,("view / xinerama" , mytest prop_view_xinerama) -- ,("view / xinerama" , mytest prop_view_xinerama)
,("view is local" , mytest prop_view_local) ,("view is local" , mytest prop_view_local)
,("greedyView : invariant" , mytest prop_greedyView_I)
,("greedyView sets current" , mytest prop_greedyView_current)
,("greedyView idempotent" , mytest prop_greedyView_idem)
,("greedyView reversible" , mytest prop_greedyView_reversible)
,("greedyView is local" , mytest prop_greedyView_local)
--
-- ,("valid workspace xinerama", mytest prop_lookupWorkspace) -- ,("valid workspace xinerama", mytest prop_lookupWorkspace)
,("peek/member " , mytest prop_member_peek) ,("peek/member " , mytest prop_member_peek)