diff options
Diffstat (limited to 'src/Rahm')
| -rw-r--r-- | src/Rahm/Desktop/Keys.hs | 13 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Layout/Explode.hs | 38 | ||||
| -rw-r--r-- | src/Rahm/Desktop/PopupTerminal.hs | 40 |
3 files changed, 78 insertions, 13 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 17b5c11..b8df00f 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -141,7 +141,8 @@ import XMonad.Layout.Spacing import XMonad.Util.Run (safeSpawn) import XMonad.Util.WindowProperties import Prelude hiding ((!!)) -import Rahm.Desktop.Layout.Explode (toggleExplode) +import Rahm.Desktop.Layout.Explode (toggleExplode, toggleExplodeM) +import Rahm.Desktop.PopupTerminal (movePopupToCurrentWorkspace, movePopupToHiddenWorkspace) type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) @@ -841,7 +842,7 @@ bindings = do altMod $ doc "Spawn a floating terminal" $ - spawnX =<< asks ((++ " -t Floating\\ Term") . terminal . config) + spawnX =<< asks ((++ " --class floating-terminal") . terminal . config) bind xK_z $ do justMod $ @@ -904,8 +905,10 @@ bindings = do -- Explode bind xK_c $ do noMod -|- justMod $ - doc "Toggle explode on the workspace" $ - sendMessage toggleExplode + doc "Toggle explode on the workspace" $ do + sendMessage (toggleExplodeM + movePopupToCurrentWorkspace + movePopupToHiddenWorkspace) bindOtherKeys $ \(_, _, s) -> @@ -945,7 +948,7 @@ bindings = do bind xF86XK_Calculator $ do noMod $ spawnX - =<< asks ((++ " -t Floating\\ Term -e /usr/bin/env python3") . terminal . config) + =<< asks ((++ " --class floating-terminal -e /usr/bin/env python3") . terminal . config) bind xF86XK_AudioLowerVolume $ do noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ -1%" diff --git a/src/Rahm/Desktop/Layout/Explode.hs b/src/Rahm/Desktop/Layout/Explode.hs index 1d25695..9e1b4d8 100644 --- a/src/Rahm/Desktop/Layout/Explode.hs +++ b/src/Rahm/Desktop/Layout/Explode.hs @@ -1,12 +1,14 @@ -{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveAnyClass, TypeOperators #-} module Rahm.Desktop.Layout.Explode where import Control.Arrow (Arrow (second)) -import Data.Foldable (minimumBy) +import Data.Foldable (minimumBy, Foldable (toList)) import Data.Ord (comparing) import qualified Rahm.Desktop.StackSet as W +import qualified XMonad.StackSet as W import XMonad +import Rahm.Desktop.PopupTerminal data Explodeable (l :: * -> *) (a :: *) = Explodeable { isExploded :: Bool, @@ -15,19 +17,30 @@ data Explodeable (l :: * -> *) (a :: *) = Explodeable deriving (Show, Read, Eq, Ord) data ExplodeMessage where - ExplodeMessage :: (forall l a. Explodeable l a -> Explodeable l a) -> ExplodeMessage + ExplodeMessage :: (forall l a. Explodeable l a -> X (Explodeable l a)) -> ExplodeMessage deriving (Message) explodeable :: l a -> Explodeable l a explodeable = Explodeable False +toggleExplodeM :: X () -> X () -> ExplodeMessage +toggleExplodeM onTrue onFalse = + ExplodeMessage $ \(Explodeable b l) -> do + if b then onFalse else onTrue + return $ Explodeable (not b) l + toggleExplode :: ExplodeMessage -toggleExplode = ExplodeMessage $ \(Explodeable b l) -> Explodeable (not b) l +toggleExplode = ExplodeMessage $ \(Explodeable b l) -> return $ Explodeable (not b) l -instance (LayoutClass l a, Eq a) => LayoutClass (Explodeable l) a where +instance (LayoutClass l a, a ~ Window) => LayoutClass (Explodeable l) a where runLayout - (W.Workspace t (Explodeable True l) stack) + (W.Workspace t (Explodeable True l) stack') rect@(Rectangle x y w h) = do + maybeWin <- getPopupTerminalWindow + let winRect = (,popRect) <$> maybeWin + + let stack = W.filter ((/=maybeWin) . Just) =<< stack' + (returned, maybeNewLayout) <- runLayout (W.Workspace t l stack) rect let (cx, cy) = (x + (fi w `div` 2), y + (fi h `div` 2)) @@ -45,8 +58,17 @@ instance (LayoutClass l a, Eq a) => LayoutClass (Explodeable l) a where ) returned - return (newReturned, Explodeable True <$> maybeNewLayout) + return (toList winRect ++ newReturned, Explodeable True <$> maybeNewLayout) where + wp = floor $ fromIntegral w * 0.10 + hp = floor $ fromIntegral h * 0.10 + popRect = + Rectangle + (x + wp) + (y + hp) + (w - fromIntegral (wp * 2)) + (h - fromIntegral (hp * 2)) + fi :: (Integral a, Num b) => a -> b fi = fromIntegral norm :: (Integral a, Integral b) => (a, b) -> (Float, Float) @@ -84,7 +106,7 @@ instance (LayoutClass l a, Eq a) => LayoutClass (Explodeable l) a where -- If the message is a ExplodeMessage, handle that here. handleMessage p (fromMessage -> Just (ExplodeMessage f)) = - return $ Just $ f p + Just <$> f p -- By default just pass the message to the underlying layout. handleMessage (Explodeable b l) mess = do maybeNewLayout <- handleMessage l mess diff --git a/src/Rahm/Desktop/PopupTerminal.hs b/src/Rahm/Desktop/PopupTerminal.hs new file mode 100644 index 0000000..fb38563 --- /dev/null +++ b/src/Rahm/Desktop/PopupTerminal.hs @@ -0,0 +1,40 @@ +module Rahm.Desktop.PopupTerminal where + +import XMonad +import qualified XMonad.Util.ExtensibleState as XS +import Data.Monoid +import Control.Monad.Trans +import qualified XMonad.StackSet as W +import Data.Foldable (forM_) +import XMonad.Util.SpawnOnce (spawnOnce) + +newtype PopupTerminalState = PopupTerminalState + { + popupTerminalWindow :: Maybe Window + } deriving (Show, Read) + +instance ExtensionClass PopupTerminalState where + initialValue = PopupTerminalState Nothing + extensionType = PersistentExtension + +getPopupTerminalWindow :: X (Maybe Window) +getPopupTerminalWindow = XS.gets popupTerminalWindow + +movePopupToCurrentWorkspace :: X () +movePopupToCurrentWorkspace = do + mWin <- getPopupTerminalWindow + forM_ mWin $ \win -> do + windows $ \ws -> + W.focusWindow win $ + W.shiftWin (W.tag (W.workspace (W.current ws))) win ws + +movePopupToHiddenWorkspace :: X () +movePopupToHiddenWorkspace = do + mWin <- getPopupTerminalWindow + forM_ mWin $ \win -> windows $ \ws -> W.shiftWin "*" win ws + +updatePopupTerminalHook :: ManageHook +updatePopupTerminalHook = Query $ do + win <- ask + lift $ XS.put $ PopupTerminalState (Just win) + return (Endo id) |