Add :: object to tile windows onto a workspace

1 files changed, 25 insertions, 8 deletions

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