From 2ec96d9c2482ecf55358bdb4218c60dadd8aecbd Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Tue, 1 Mar 2011 02:31:21 +0100
Subject: Forget empty window groups

---
 lib/ProcessWorkspaces.hs | 32 ++++++++++++++++++++++++++++----
 1 file changed, 28 insertions(+), 4 deletions(-)

(limited to 'lib')

diff --git a/lib/ProcessWorkspaces.hs b/lib/ProcessWorkspaces.hs
index 8789c51..72f4270 100644
--- a/lib/ProcessWorkspaces.hs
+++ b/lib/ProcessWorkspaces.hs
@@ -4,13 +4,16 @@ module ProcessWorkspaces ( setProcessWorkspace
                          , getProcessWorkspace
                          , doAutoShift
                          , doIgnoreProcessWorkspace
+                         , ignoreProcessWorkspace
+                         , ignoreWinProcessWorkspace
                          , regroupProcess
                          , regroupWinProcess
                          , shiftIgnoreGroup
                          , shiftWinIgnoreGroup
                          , shiftGroup
                          , shiftWinGroup
-                         , processWorkspaceStorage
+                         , handleForgetEmptyWindowGroups
+                         , processWorkspaceManager
                          , spawnOn
                          , spawnOnCurrent
                          ) where
@@ -21,17 +24,20 @@ import qualified XMonad.StackSet as W
 import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
 import XMonad.Hooks.ManageHelpers (pid)
 import Graphics.X11.Types (Window)
+import Graphics.X11.Xlib.Extras (Event)
 
 import System.Posix.Process (getProcessPriority)
 import System.Posix.Types (ProcessID)
 
 import Control.Monad
 import Data.Maybe
+import Data.Monoid
 import qualified Data.Map as M
 
 import Storage
 
 
+
 doAutoShift :: ManageHook
 doAutoShift = do
   mp <- pid
@@ -53,6 +59,12 @@ doIgnoreProcessWorkspace = do
     liftX $ setProcessWorkspace (fromJust mp) Nothing
   idHook
 
+ignoreProcessWorkspace :: X ()
+ignoreProcessWorkspace = withFocused ignoreWinProcessWorkspace
+
+ignoreWinProcessWorkspace :: Window -> X ()
+ignoreWinProcessWorkspace w = runQuery doIgnoreProcessWorkspace w >> return ()
+
 regroupProcess :: WorkspaceId -> X ()
 regroupProcess ws = withFocused $ regroupWinProcess ws
 
@@ -67,7 +79,7 @@ shiftIgnoreGroup ws = withFocused $ shiftWinIgnoreGroup ws
 
 shiftWinIgnoreGroup :: WorkspaceId -> Window -> X ()
 shiftWinIgnoreGroup ws w = do
-  runQuery doIgnoreProcessWorkspace w
+  ignoreWinProcessWorkspace w
   windows $ W.shiftWin ws w
 
 shiftGroup :: WorkspaceId -> X ()
@@ -89,13 +101,25 @@ shiftWinGroup ws w = do
     _ ->
       windows $ W.shiftWin ws w
 
+handleForgetEmptyWindowGroups :: Event -> X All
+handleForgetEmptyWindowGroups (UnmapEvent {ev_window = w}) = do
+  mp <- runQuery pid w
+  when (isJust mp) $ do
+    wins <- withWindowSet $ return . W.allWindows
+    hasWindows <- foldM (\b w' -> liftM ((|| b) . (&& (w /= w')) . (== mp)) . runQuery pid $ w') False wins
+    unless hasWindows $ updateStoreData ((\(ProcessWorkspaceStoreData map) -> ProcessWorkspaceStoreData $ M.delete (fromJust mp) map))
+  return $ All True
+
+handleForgetEmptyWindowGroups _ = return $ All True
+
 
 data ProcessWorkspaceStoreData = ProcessWorkspaceStoreData (M.Map ProcessID (Maybe WorkspaceId))
                                  deriving (Typeable, Show, Read)
 instance StoreData ProcessWorkspaceStoreData
 
-processWorkspaceStorage :: (LayoutClass l a) => l a -> ModifiedLayout (Storage ProcessWorkspaceStoreData) l a
-processWorkspaceStorage = storage $ ProcessWorkspaceStoreData M.empty
+
+processWorkspaceManager :: (LayoutClass l a) => l a -> ModifiedLayout (Storage ProcessWorkspaceStoreData) l a
+processWorkspaceManager = storage (ProcessWorkspaceStoreData M.empty)
 
 setProcessWorkspace :: ProcessID -> Maybe WorkspaceId -> X ()
 setProcessWorkspace pid ws = do
-- 
cgit v1.2.3