From 3433ac66496a153487c24a2c80230e5274658352 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Fri, 29 Feb 2008 23:43:16 +0100 Subject: implement ScratchWorkspace. darcs-hash:20080229224316-72aca-9bd38478665ad2effabef8966cc6010fc0fcfe0a.gz --- XMonad/Config/Droundy.hs | 8 +++- XMonad/Layout/ScratchWorkspace.hs | 77 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 84 insertions(+), 1 deletion(-) create mode 100644 XMonad/Layout/ScratchWorkspace.hs (limited to 'XMonad') diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs index 4cdf726..7e88c3f 100644 --- a/XMonad/Config/Droundy.hs +++ b/XMonad/Config/Droundy.hs @@ -26,6 +26,7 @@ import XMonad.Layout.Combo import XMonad.Layout.Mosaic import XMonad.Layout.Named import XMonad.Layout.LayoutCombinators +import XMonad.Layout.Simplest import XMonad.Layout.Square import XMonad.Layout.LayoutScreens import XMonad.Layout.WindowNavigation @@ -33,6 +34,7 @@ import XMonad.Layout.NoBorders import XMonad.Layout.WorkspaceDir import XMonad.Layout.ToggleLayouts import XMonad.Layout.ShowWName +import XMonad.Layout.ScratchWorkspace import XMonad.Prompt import XMonad.Prompt.Layout @@ -111,6 +113,8 @@ keys x = M.fromList $ , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig) , ((modMask x, xK_l ), layoutPrompt myXPConfig) , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout) + , ((modMask x .|. controlMask .|. shiftMask, xK_space), + toggleScratchWorkspace (Simplest */* Simplest) ) -- keybindings for Mosaic: , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow)) @@ -132,7 +136,7 @@ config = -- withUrgencyHook FocusUrgencyHook $ withUrgencyHook NoUrgencyHook $ defaultConfig { borderWidth = 1 -- Width of the window border in pixels. - , XMonad.workspaces = ["1:mutt","2:iceweasel"] + , XMonad.workspaces = ["mutt","iceweasel","*scratch*"] , layoutHook = showWName $ workspaceDir "~" $ windowNavigation $ toggleLayouts (noBorders Full) $ avoidStruts $ named "tabbed" (noBorders mytab) ||| @@ -167,10 +171,12 @@ instance Shrinker CustomShrink where shrinkIt _ s = shrinkIt shrinkText s dropFromTail :: String -> String -> Maybe String +dropFromTail "" _ = Nothing dropFromTail t s | drop (length s - length t) s == t = Just $ take (length s - length t) s | otherwise = Nothing dropFromHead :: String -> String -> Maybe String +dropFromHead "" _ = Nothing dropFromHead h s | take (length h) s == h = Just $ drop (length h) s | otherwise = Nothing 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) -- cgit v1.2.3