Forget empty window groups

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

xmonad.hs

@@ -93,12 +93,10 @@ myManageHook :: ManageHook
 myManageHook = composeAll
                [ isDialog --> doFloat
                , composeOne
-                 [ className =? "Guake.py"   -?> (doFloatMaybeFullscreen <+> doIgnoreProcessWorkspace) -- <+> doConfigBorderOff)
+                 [ className =? "Guake.py"   -?> doFloatMaybeFullscreen -- <+> doConfigBorderOff)
                  --, className =? "Do"         -?> (doFloat <+> doConfigBorderOff)
-                 , className =? "Gmpc"       -?> doIgnoreProcessWorkspace
-                 , className =? "Liferea"    -?> doIgnoreProcessWorkspace
-                 , className =? "Gnome-session" -?> doIgnoreProcessWorkspace
                  , className =? "MPlayer"    -?> doCenterFloat
+                 , className =? "Gnome-session" -?> doIgnoreProcessWorkspace
                  , className =? "Gimp"       -?> doFloat
                  , className =? "Display"    -?> doFloat
                  , className =? "Wine"       -?> doFloat
@@ -111,7 +109,7 @@ myManageHook = composeAll
                ]
         
 
-myLayoutHook = processWorkspaceStorage $ manageFullscreen $ smartBorders (Full ||| tiled ||| Mirror tiled)
+myLayoutHook = processWorkspaceManager $ manageFullscreen $ smartBorders (Full ||| tiled ||| Mirror tiled)
   where
     -- default tiling algorithm partitions the screen into two panes
     tiled   = ResizableTall nmaster delta ratio []
@@ -127,5 +125,6 @@ myLayoutHook = processWorkspaceStorage $ manageFullscreen $ smartBorders (Full |
 
 myEventHook :: Event -> X All
 myEventHook ev = do
+  handleForgetEmptyWindowGroups ev
   handleFullscreen ev
   (handleEventHook gnomeConfig) ev