Add :: object to tile windows onto a workspace

2 files changed, 55 insertions, 8 deletions

diff --git a/README.md b/README.md
index 7661ba3..06a8631 100644
--- a/README.md
+++ b/README.md
@@ -116,6 +116,10 @@ will "goto" the workspace 'a'. Typing `<M-w>s` will go to the window tagged with
   * `<M-s>|@a@b.` Move all the windows on workspaces 'a' and 'b' to the current
     workspace.
 
+  * `<M-s>%.<M-s>%:s` Float all windows.
+
+  * `<M-s>%.<M-s>%::s` Sink all windows.
+
   * `<M-s>--` Undo the last shift.
 
 It looks complicated, but it's actually quite simple. All WML "sentances" start
@@ -162,6 +166,10 @@ workspaces.
    * `,`: The workspace on the monitor to the right of the next typed workspace
      (i.e. `,a` is the workspace to the right of workspace a. '
    * `;`: Like `,`, but to the left.
+   * `:`: Delegates to the next workspace, but float windows sent to it. (i.e.
+     `<M-s>@.:.` will float all the windows on the current screen.
+   * `::`: Delegates to the next workspace, but sink windows sent to it. (i.e.
+     `<M-s>@.::.` will sink all the windows on the current screen.
    * `/`: Search for a window and reference the workspace on that window.
    * `@`: The workspace associated with the following window set object. (i.e.
      `@a` references the workspace the window marked a is on)
@@ -244,3 +252,25 @@ exactly what one is wanting to do.
         the list. So it's all windows on the current workspace, except the last
         two.
       * `,.`: The workspace on the screen to the right.
+
+  * `<M-s>%.<M-s>%:-`: *Float all windows*
+
+      * `<M-s>%.` Moves all the windows to the current workspace.
+      * `<M-s>%:.` Moves all the windows back to where they came from, but
+        floats them.
+
+#### Some Identities
+
+  * `<M-s>..` is a No-op. It move the current window to the current workspace,
+    which does nothing.
+
+  * `&x_` References nothing for any x because `_` is the empty windowset.
+
+  * `|_x` References x for any x.
+
+  * `<M-g>.` Is a No-op. It just goes to the current workspace
+
+  * `<M-s>@xx` is a no-op for any x because it just moves all windows on
+    workspace x to worksapce x.
+
+  * `,;x` is just references x for any x because the `;` undos the `,`
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index babf3b5..0dfb852 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -17,9 +17,10 @@ module Rahm.Desktop.Keys.Wml where
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.State as S
 import Control.Monad.Trans.Class
-import Control.Monad (join, forM_)
+import Control.Monad (join, forM_, unless)
 import Data.List (sortOn, intercalate)
 import Data.Ord (Down(..))
+import Data.Typeable (cast)
 
 import qualified Data.Map as Map
 import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
@@ -43,10 +44,11 @@ import Text.Printf
 import XMonad
 
 data Workspace =
-  Workspace {
+  forall a. (Typeable a) => Workspace {
     moveLocationToWorkspaceFn :: Location -> X ()
   , gotoWorkspaceFn :: X ()
   , workspaceName :: String
+  , extraWorkspaceData :: a
   }
 
 justWorkspace :: String -> Workspace
@@ -55,6 +57,7 @@ justWorkspace s =
     moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
   , gotoWorkspaceFn = gotoWorkspace s
   , workspaceName = s
+  , extraWorkspaceData = ()
   }
 
 blackHoleWorkspace :: Workspace
@@ -63,6 +66,7 @@ blackHoleWorkspace =
     moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow
   , gotoWorkspaceFn = return () -- can't navigate to black hole
   , workspaceName = "blackhole"
+  , extraWorkspaceData = ()
   }
 
 alternateWorkspace :: Workspace
@@ -85,19 +89,32 @@ alternateWorkspace =
           mapM_ gotoWorkspace =<<  getAlternateWorkspace win
 
   , workspaceName = "@"
+  , extraWorkspaceData = ()
   }
 
+newtype FloatWorkspace = FloatWorkspace Workspace
+
 floatWorkspace :: Workspace -> Workspace
-floatWorkspace ws =
+floatWorkspace ws@Workspace { extraWorkspaceData = d } =
   Workspace {
     moveLocationToWorkspaceFn = \location -> do
+
       forM_ (locationWindow location) $ \win -> do
-        logs $ "Float " ++ show win
-        windows $ W.float win (W.RationalRect 0 0 100 100)
-        withWindowSet $ logs . show . W.floating
-      moveLocationToWorkspaceFn ws location
+        case cast d of
+          Just (FloatWorkspace ws') -> do
+            windows $ W.sink win
+            moveLocationToWorkspaceFn ws' location
+          Nothing -> do
+            windows $ \ss ->
+              if win `Map.member` W.floating ss
+                then ss -- win is already floating
+                else W.float win (W.RationalRect (1/8) (1/8) (6/8) (6/8)) ss
+            moveLocationToWorkspaceFn ws location
+
+
   , gotoWorkspaceFn = gotoWorkspaceFn ws
   , workspaceName = workspaceName ws
+  , extraWorkspaceData = FloatWorkspace ws
   }
 
 joinMaybe :: (Monad m) => MaybeT m (Maybe a) -> MaybeT m a
@@ -248,7 +265,7 @@ readNextLocationSet =
         ret <- mapM windowLocation =<< lift (withWindowSet (return . sortOn Down . W.allWindows))
         lift $ logs $ "allWindows " ++ intercalate "\n"  (map show ret)
         return ret
-      (_, _, "@") ->
+      (_, _, s) | s == "\t" || s == "@" || s == "\n" ->
         (mt . windowsInWorkspace . workspaceName) =<< readNextWorkspace
       (_, _, "!") -> (:[]) <$> joinMaybe (head <$> readNextLocationSet)
       (_, _, ",") -> tail <$> readNextLocationSet