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 "*").

3 files changed, 135 insertions, 9 deletions

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 "<fn=1><fc=#ffffff>["
+                  tell theater
+                  tell "]  </fc></fn>"
+
+                Nothing -> tell " "
+
               forM_ wss $ \(t, ws) -> do
                 case t of
                   Current -> tell "<fn=1><fc=#ff8888>"