From d3d67d059d2b56ceac63cebaa34802f2fb5a5019 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 20 Nov 2022 17:11:34 -0700 Subject: Add "Theaters" to RDE. A "Theater" is basically the state of the "StackSet". This means that jumping to a Theater will reset all the windows to where they were when the user last left that theater, or an empty theater if there is not. New windows that a theater does not know about are put in the "hidden" workspace (which is "*"). --- src/Rahm/Desktop/Keys.hs | 25 ++++++---- src/Rahm/Desktop/Theater.hs | 107 ++++++++++++++++++++++++++++++++++++++++++ src/Rahm/Desktop/XMobarLog.hs | 12 ++++- 3 files changed, 135 insertions(+), 9 deletions(-) create mode 100644 src/Rahm/Desktop/Theater.hs (limited to 'src') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index edeb77e..556b318 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -65,6 +65,7 @@ import Rahm.Desktop.Swallow import Rahm.Desktop.SwapMaster (swapMaster) import Rahm.Desktop.Workspaces import Rahm.Desktop.Desktop +import Rahm.Desktop.Theater import qualified Rahm.Desktop.StackSet as W import Rahm.Desktop.History @@ -283,7 +284,7 @@ keymap = runKeys $ do runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace shiftMod $ - doc "Restore the theater marked with the next typed character." $ + doc "Restore the desktop marked with the next typed character." $ runMaybeT_ $ do mapNextString $ \_ str -> lift $ case str of @@ -297,13 +298,13 @@ keymap = runKeys $ do -- (,) <$> readNextWorkspaceName <*> readNextWorkspaceName controlMod $ - doc "Move the current focused window to another workspace and view that workspace" $ + doc "Restore a theater state" $ runMaybeT_ $ do - ws <- readNextWorkspace - loc <- lift getCurrentLocation - lift $ do - moveLocationToWorkspaceFn ws loc - gotoWorkspaceFn ws + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> restoreTheater (Just [ch]) + [' '] -> restoreTheater Nothing + _ -> return () bind xK_n $ do justMod $ @@ -423,13 +424,21 @@ keymap = runKeys $ do _ -> return () shiftMod $ - doc "Mark the current theater with the next typed character." $ + doc "Mark the current desktop with the next typed character." $ runMaybeT_ $ do mapNextString $ \_ str -> lift $ case str of [ch] | isAlpha ch -> saveCurrentDesktop str _ -> return () + controlMod $ + doc "Mark the current theater with the next typed character." $ + runMaybeT_ $ do + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> saveCurrentTheater (Just str) + _ -> return () + bind xK_plus $ do justMod $ doc "Increase the number of windows in the master region." $ diff --git a/src/Rahm/Desktop/Theater.hs b/src/Rahm/Desktop/Theater.hs new file mode 100644 index 0000000..5c324ab --- /dev/null +++ b/src/Rahm/Desktop/Theater.hs @@ -0,0 +1,107 @@ +module Rahm.Desktop.Theater where + + +-- A "Theater" is the state of a stackset. One can save the current stackset as +-- a "theater" and then restore it later. If new windows were added, those new +-- windows are put into the hidden workspace. + +import qualified XMonad as X +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS + +import XMonad (X) +import Data.List ((\\)) +import Data.Typeable +import Data.Proxy +import Data.Maybe +import Data.Default +import Control.Monad (forM_) +import Data.Map (Map) +import qualified Data.Map as Map + +type WinSet = W.StackSet X.WorkspaceId String X.Window X.ScreenId X.ScreenDetail + +newtype Theater = Theater WinSet + deriving (Read, Show) + +type TheaterName = Maybe String + +data Theaters = Theaters { + currentTheater :: TheaterName + , theaters :: Map TheaterName Theater + } deriving (Read, Show) + +instance Default Theaters where + def = Theaters Nothing mempty + +instance X.ExtensionClass Theaters where + initialValue = def + extensionType = X.PersistentExtension + +getCurrentTheaterName :: X TheaterName +getCurrentTheaterName = currentTheater <$> XS.get + +saveTheater :: TheaterName -> X.WindowSet -> X () +saveTheater name ws = + XS.modify $ \(Theaters cur map) -> + Theaters cur $ Map.insert name (Theater $ unboxLayout ws) map + + where + unboxLayout = W.mapLayout show + +saveCurrentTheater :: TheaterName -> X () +saveCurrentTheater = X.withWindowSet . saveTheater + +restoreTheater :: TheaterName -> X () +restoreTheater name = do + currentWindowset <- X.windowset <$> X.get + currentTheaterName <- currentTheater <$> XS.get + currentLayout <- W.layout . W.workspace . W.current . X.windowset <$> X.get + + saveTheater currentTheaterName currentWindowset + + newStackSet' <- do + (Theaters cur mp) <- XS.get + case Map.lookup name mp of + Nothing -> do + ws <- X.windowset <$> X.get + return $ W.mapWorkspace ( + \(W.Workspace i l _) -> W.Workspace i l Nothing) ws + + Just (Theater ws) -> + return $ W.mapLayout ( + \serialized -> case [x | (x, "") <- X.readsLayout currentLayout serialized] of + [x] -> x + [] -> currentLayout + (_:_) -> currentLayout + ) ws + + let newStackSet = updateStateWithWindows (W.allWindows currentWindowset) "*" newStackSet' + + saveTheater Nothing currentWindowset + saveTheater name newStackSet + + XS.modify $ \(Theaters _ m) -> Theaters name m + X.windows $ const newStackSet + +updateStateWithWindows :: + (Eq i, Eq a) => [a] -> i -> W.StackSet i l a si sd -> W.StackSet i l a si sd +updateStateWithWindows allWindows hiddenWorkspace ss = + let missingWindows = allWindows \\ W.allWindows ss + layout = W.layout $ W.workspace $ W.current ss in + if null missingWindows + then ss + else + if not (W.tagMember hiddenWorkspace ss) + then + ss { W.hidden = + W.Workspace hiddenWorkspace layout (W.differentiate missingWindows) + : W.hidden ss} + + else + W.mapWorkspace (\(W.Workspace t l s') -> + let s = W.filter (`elem`allWindows) =<< s' in + if t == hiddenWorkspace + then + W.Workspace t l (W.differentiate $ W.integrate' s ++ missingWindows) + else W.Workspace t l s) ss diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs index af0a1a1..9ea8bad 100644 --- a/src/Rahm/Desktop/XMobarLog.hs +++ b/src/Rahm/Desktop/XMobarLog.hs @@ -15,6 +15,7 @@ import XMonad (X) import Rahm.Desktop.Workspaces (getPopulatedWorkspaces, WorkspaceState(..)) import Text.Printf import Rahm.Desktop.Logger +import Rahm.Desktop.Theater (getCurrentTheaterName) import qualified XMonad as X import qualified Rahm.Desktop.StackSet as S @@ -41,6 +42,7 @@ xMobarLogHook (XMobarLog xmproc) = do (_, _, layoutXpm) <- drawLayout loglevel <- getLogLevel + currentTheater <- getCurrentTheaterName winset <- X.gets X.windowset title <- maybe (pure "") (fmap show . getName) . S.peek $ winset @@ -49,9 +51,17 @@ xMobarLogHook (XMobarLog xmproc) = do let log = trunc 80 $ execWriter $ do tell " " tell (toChangeLayoutAction layoutXpm) - tell " " + tell " " tell $ logLevelToXMobar loglevel + case currentTheater of + Just theater -> do + tell "[" + tell theater + tell "] " + + Nothing -> tell " " + forM_ wss $ \(t, ws) -> do case t of Current -> tell "" -- cgit