aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Layout
diff options
context:
space:
mode:
authorDavid Roundy <droundy@darcs.net>2008-02-29 23:43:16 +0100
committerDavid Roundy <droundy@darcs.net>2008-02-29 23:43:16 +0100
commit3433ac66496a153487c24a2c80230e5274658352 (patch)
tree10a9ac6745805493b9a42460a8d3a80ad97bd71f /XMonad/Layout
parent363314e16a5a39f21e34b0ff4ae0532f444be978 (diff)
downloadXMonadContrib-3433ac66496a153487c24a2c80230e5274658352.tar.gz
XMonadContrib-3433ac66496a153487c24a2c80230e5274658352.tar.xz
XMonadContrib-3433ac66496a153487c24a2c80230e5274658352.zip
implement ScratchWorkspace.
darcs-hash:20080229224316-72aca-9bd38478665ad2effabef8966cc6010fc0fcfe0a.gz
Diffstat (limited to 'XMonad/Layout')
-rw-r--r--XMonad/Layout/ScratchWorkspace.hs77
1 files changed, 77 insertions, 0 deletions
diff --git a/XMonad/Layout/ScratchWorkspace.hs b/XMonad/Layout/ScratchWorkspace.hs
new file mode 100644
index 0000000..04b18bd
--- /dev/null
+++ b/XMonad/Layout/ScratchWorkspace.hs
@@ -0,0 +1,77 @@
+{-# 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
+ 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}
+ 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
+
+scratchName :: String
+scratchName = "*scratch*"
+
+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)
+
+isScratchVisible :: X Bool
+isScratchVisible = gets (elem scratchName . map (W.tag . W.workspace) . W.visible . windowset)