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

darcs-hash:20070815025504-a5988-00ff316a056c48cc07c5e90925702d2ac09ae666

3 files changed, 57 insertions, 2 deletions

diff --git a/Operations.hs b/Operations.hs
index d5a5d3e..dce8195 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -92,7 +92,7 @@ shift n = windows (W.shift n)
 
 -- | view. Change the current workspace to workspace at offset n (0 indexed).
 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
 -- Taking a function giving the current screen, and current geometry.
diff --git a/StackSet.hs b/StackSet.hs
index 40d1c0b..5f69448 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -15,7 +15,7 @@ module StackSet (
         StackSet(..), Workspace(..), Screen(..), StackOrNot, Stack(..), RationalRect(..),
         -- *  Construction
         -- $construction
-        new, view,
+        new, view, greedyView,
         -- * Xinerama operations
         -- $xinerama
         lookupWorkspace,
@@ -244,6 +244,25 @@ view i s
     -- 'Catch'ing this might be hard. Relies on monotonically increasing
     -- 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
 
diff --git a/tests/Properties.hs b/tests/Properties.hs
index 589275a..e11b448 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -136,6 +136,9 @@ prop_empty_I  (n :: Positive Int) = forAll (choose (1,fromIntegral n)) $  \m ->
 prop_view_I (n :: NonNegative Int) (x :: T) =
     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) =
     invariant $ foldr (const focusUp) x [1..n]
 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
     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
 normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) }
     where
@@ -518,6 +548,12 @@ main = do
 --      ,("view / xinerama"     , mytest prop_view_xinerama)
         ,("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)
 
         ,("peek/member "        , mytest prop_member_peek)