mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-09-01 20:03:46 -07:00
79 lines
4.0 KiB
Haskell
79 lines
4.0 KiB
Haskell
{-# 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)
|