1 files changed, 107 insertions, 0 deletions
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