{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.ScratchWorkspace
-- Copyright : (c) Braden Shepherdson, David Roundy 2008
-- License : BSD-style (as xmonad)
--
-- Maintainer : Braden.Shepherdson@gmail.com
-- Stability : unstable
-- Portability : unportable
module XMonad.Layout.ScratchWorkspace ( toggleScratchWorkspace ) where
import Data.Maybe ( listToMaybe, catMaybes )
import Control.Monad ( guard, when )
import XMonad
import XMonad.Core
import qualified XMonad.StackSet as W
toggleScratchWorkspace :: LayoutClass l Int => l Int -> X ()
toggleScratchWorkspace l =
do s <- gets windowset
when (scratchName `W.tagMember` s) $
case visibleScratch s of
Just oldscratch ->
do srs <- withDisplay getCleanedScreenInfo
when (length srs == length (W.visible s)) $ do
ml <- handleMessage (W.layout $ W.workspace oldscratch) (SomeMessage Hide)
let scratch = case ml of
Nothing -> oldscratch
Just l' -> oldscratch { W.workspace =
(W.workspace oldscratch) { W.layout = l' } }
mapM_ hide $ W.integrate' $ W.stack $ W.workspace scratch
let modscr scr = do guard $ scratchName /= W.tag (W.workspace scr)
Just $ scr { W.screenDetail = newDetail }
where newDetail = (W.screenDetail scr)
{ screenRect = pickRect (W.screen scr) srs }
pickRect _ [z] = z
pickRect i (z:zs) | i < 1 = z
| otherwise = pickRect (i-1) zs
pickRect _ [] = error "XMonad.Layout.ScratchWorkspace.toggleScratchWorkspace: internal error"
s' = case catMaybes $ map modscr $ W.current s : W.visible s of
newc:newv -> s { W.current = newc, W.visible = newv,
W.hidden = W.workspace scratch : W.hidden s}
[] -> error "XMonad.Layout.ScratchWorkspace.toggleScratchWorkspace: internal error"
modify $ \st -> st { windowset = s' }
refresh
Nothing ->
case hiddenScratch s of
Nothing -> return ()
Just hs -> do r <- gets (screenRect . W.screenDetail . W.current . windowset)
(rs,_) <- doLayout l r (W.Stack 0 [1] [])
let (r0, r1) = case rs of
[(0,ra),(1,rb)] -> (ra,rb)
[(1,ra),(0,rb)] -> (rb,ra)
[(1,ra)] -> (r,ra)
[(0,ra)] -> (ra,r)
_ -> (r,r)
c' = (W.current s) { W.screenDetail =
(W.screenDetail (W.current s)) { screenRect = r1 }}
let s' = s { W.current = W.Screen hs (-1) (SD r0 (0,0,0,0)),
W.visible = c': W.visible s,
W.hidden = filter (not . isScratchW) $ W.hidden s }
modify $ \st -> st { windowset = s' }
refresh
where visibleScratch s = listToMaybe $ filter isScratch $ W.current s : W.visible s
hiddenScratch s = listToMaybe $ filter isScratchW $ W.hidden s
isScratchW w = scratchName == W.tag w
isScratch scr = scratchName == W.tag (W.workspace scr)
-- notScratch scr = scratchName /= W.tag (W.workspace scr)
scratchName :: String
scratchName = "*scratch*"
-- isScratchVisible :: X Bool
-- isScratchVisible = gets (elem scratchName . map (W.tag . W.workspace) . W.visible . windowset)
