diff options
Diffstat (limited to 'src/Rahm')
| -rw-r--r-- | src/Rahm/Desktop/Keys/Wml.hs | 33 |
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 |