summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--XMonad/Core.hs12
-rw-r--r--XMonad/Main.hsc3
-rw-r--r--XMonad/Operations.hs48
-rw-r--r--XMonad/StackSet.hs75
4 files changed, 65 insertions, 73 deletions
diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index 20d7258..e60a01a 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -48,7 +48,7 @@ import System.Posix.Types (ProcessID)
import System.Process
import System.Directory
import System.Exit
-import Graphics.X11.Xlib
+import Graphics.X11.Xlib hiding (Screen)
import Graphics.X11.Xlib.Extras (Event)
import Data.Typeable
import Data.List ((\\))
@@ -424,10 +424,12 @@ xfork x = io . forkProcess . finally nullStdin $ do
runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
runOnWorkspaces job = do
ws <- gets windowset
- h <- mapM job $ hidden ws
- c:v <- mapM (\s -> (\w -> s { workspace = w}) <$> job (workspace s))
- $ current ws : visible ws
- modify $ \s -> s { windowset = ws { current = c, visible = v, hidden = h } }
+ c:v <- mapM runOnScreen $ current ws : visible ws
+ modify $ \s -> s { windowset = ws { current = c, visible = v } }
+ where
+ runOnScreen scr@Screen { screenWorkspace = w, screenHidden = ws } = do
+ w':ws' <- mapM job (w:ws)
+ return scr { screenWorkspace = w', screenHidden = ws' }
-- | Return the path to @~\/.xmonad@.
getXMonadDir :: MonadIO m => m String
diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc
index 5d59042..75cb94c 100644
--- a/XMonad/Main.hsc
+++ b/XMonad/Main.hsc
@@ -104,8 +104,7 @@ xmonad initxmc = do
winset = fromMaybe initialWinset $ do
("--resume" : s : _) <- return args
ws <- maybeRead reads s
- return . W.ensureTags layout (workspaces xmc)
- $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
+ return $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
extState = fromMaybe M.empty $ do
("--resume" : _ : dyns : _) <- return args
vals <- maybeRead reads dyns
diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs
index 41fbed0..c005335 100644
--- a/XMonad/Operations.hs
+++ b/XMonad/Operations.hs
@@ -63,7 +63,7 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws
| otherwise = W.insertUp w ws
- where i = W.tag $ W.workspace $ W.current ws
+ where i = W.tag $ W.screenWorkspace $ W.current ws
mh <- asks (manageHook . config)
g <- appEndo <$> userCodeDef (Endo id) (runQuery mh w)
@@ -104,7 +104,7 @@ kill = withFocused killWindow
windows :: (WindowSet -> WindowSet) -> X ()
windows f = do
XState { windowset = old } <- get
- let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old
+ let oldvisible = concatMap (W.integrate' . W.stack . W.screenWorkspace) $ W.screens old
newwindows = W.allWindows ws \\ W.allWindows old
ws = f old
XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask
@@ -115,18 +115,18 @@ windows f = do
modify (\s -> s { windowset = ws })
-- notify non visibility
- let tags_oldvisible = map (W.tag . W.workspace) $ W.current old : W.visible old
+ let tags_oldvisible = map (W.tag . W.screenWorkspace) $ W.screens old
gottenhidden = filter (flip elem tags_oldvisible . W.tag) $ W.hidden ws
mapM_ (sendMessageWithNoRefresh Hide) gottenhidden
-- for each workspace, layout the currently visible workspaces
let allscreens = W.screens ws
- summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens
+ summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.screenWorkspace) allscreens
rects <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do
- let wsp = W.workspace w
+ let wsp = W.screenWorkspace w
this = W.view n ws
n = W.tag wsp
- tiled = (W.stack . W.workspace . W.current $ this)
+ tiled = (W.stack . W.screenWorkspace . W.current $ this)
>>= W.filter (`M.notMember` W.floating ws)
>>= W.filter (`notElem` vis)
viewrect = screenRect $ W.screenDetail w
@@ -269,12 +269,11 @@ rescreen :: X ()
rescreen = do
xinesc <- withDisplay getCleanedScreenInfo
- windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
- let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs
- (a:as) = zipWith3 W.Screen xs [0..] $ map SD xinesc
- in ws { W.current = a
- , W.visible = as
- , W.hidden = ys }
+ windows $ \ws ->
+ let (xs, ys) = splitAt (length xinesc) $ W.workspaces ws
+ (a:as) = zipWith3 (flip W.Screen []) xs [0..] $ map SD xinesc
+ in ws { W.current = a { W.screenHidden = ys }
+ , W.visible = as }
-- ---------------------------------------------------------------------
@@ -302,7 +301,7 @@ setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.p
-- the mouse to a new screen).
focus :: Window -> X ()
focus w = local (\c -> c { mouseFocused = True }) $ withWindowSet $ \s -> do
- let stag = W.tag . W.workspace
+ let stag = W.tag . W.screenWorkspace
curr = stag $ W.current s
mnew <- maybe (return Nothing) (fmap (fmap stag) . uncurry pointScreen)
=<< asks mousePosition
@@ -319,9 +318,9 @@ setFocusX w = withWindowSet $ \ws -> do
dpy <- asks display
-- clear mouse button grab and border on other windows
- forM_ (W.current ws : W.visible ws) $ \wk ->
- forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw ->
- setButtonGrab True otherw
+ forM_ (W.screens ws) $ \wk ->
+ forM_ (W.index (W.view (W.tag (W.screenWorkspace wk)) ws)) $ \otherw ->
+ setButtonGrab True otherw
-- If we ungrab buttons on the root window, we lose our mouse bindings.
whenX (not <$> isRoot w) $ setButtonGrab False w
@@ -354,20 +353,17 @@ setFocusX w = withWindowSet $ \ws -> do
-- layout the windows, then refresh.
sendMessage :: Message a => a -> X ()
sendMessage a = do
- w <- W.workspace . W.current <$> gets windowset
+ w <- W.screenWorkspace . W.current <$> gets windowset
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
whenJust ml' $ \l' ->
windows $ \ws -> ws { W.current = (W.current ws)
- { W.workspace = (W.workspace $ W.current ws)
+ { W.screenWorkspace = (W.screenWorkspace $ W.current ws)
{ W.layout = l' }}}
-- | Send a message to all layouts, without refreshing.
broadcastMessage :: Message a => a -> X ()
-broadcastMessage a = withWindowSet $ \ws -> do
- let c = W.workspace . W.current $ ws
- v = map W.workspace . W.visible $ ws
- h = W.hidden ws
- mapM_ (sendMessageWithNoRefresh a) (c : v ++ h)
+broadcastMessage a = withWindowSet $ \ws ->
+ mapM_ (sendMessageWithNoRefresh a) (W.workspaces ws)
-- | Send a message to a layout, without refreshing.
sendMessageWithNoRefresh :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X ()
@@ -383,9 +379,9 @@ updateLayout i ml = whenJust ml $ \l ->
-- | Set the layout of the currently viewed workspace
setLayout :: Layout Window -> X ()
setLayout l = do
- ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset
+ ss@(W.StackSet { W.current = c@(W.Screen { W.screenWorkspace = ws })}) <- gets windowset
handleMessage (W.layout ws) (SomeMessage ReleaseResources)
- windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }
+ windows $ const $ ss {W.current = c { W.screenWorkspace = ws { W.layout = l } } }
------------------------------------------------------------------------
-- Utilities
@@ -479,7 +475,7 @@ float w = do
(sc, rr) <- floatLocation w
windows $ \ws -> W.float w rr . fromMaybe ws $ do
i <- W.findTag w ws
- guard $ i `elem` map (W.tag . W.workspace) (W.screens ws)
+ guard $ i `elem` concatMap (map W.tag . W.screenWorkspaces) (W.screens ws)
f <- W.peek ws
sw <- W.lookupWorkspace sc ws
return (W.focusWindow f . W.shiftWin sw w $ ws)
diff --git a/XMonad/StackSet.hs b/XMonad/StackSet.hs
index a7e9f6b..da87ccf 100644
--- a/XMonad/StackSet.hs
+++ b/XMonad/StackSet.hs
@@ -31,12 +31,12 @@ module XMonad.StackSet (
-- * Xinerama operations
-- $xinerama
lookupWorkspace,
- screens, workspaces, allWindows, currentTag,
+ screens, screenWorkspaces, workspaces, hidden, allWindows, currentTag,
-- * Operations on the current stack
-- $stackOperations
peek, index, integrate, integrate', differentiate,
focusUp, focusDown, focusUp', focusDown', focusMaster, focusWindow,
- tagMember, renameTag, ensureTags, member, findTag, mapWorkspace, mapLayout,
+ tagMember, renameTag, member, findTag, mapWorkspace, mapLayout,
-- * Modifying the stackset
-- $modifyStackset
insertUp, delete, delete', filter,
@@ -52,9 +52,9 @@ module XMonad.StackSet (
) where
import Prelude hiding (filter)
+import Data.Function (on)
import Data.Maybe (listToMaybe,isJust,fromMaybe)
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
-import Data.List ( (\\) )
import qualified Data.Map as M (Map,insert,delete,empty)
-- $intro
@@ -134,12 +134,12 @@ import qualified Data.Map as M (Map,insert,delete,empty)
data StackSet i l a sid sd =
StackSet { current :: !(Screen i l a sid sd) -- ^ currently focused workspace
, visible :: [Screen i l a sid sd] -- ^ non-focused workspaces, visible in xinerama
- , hidden :: [Workspace i l a] -- ^ workspaces not visible anywhere
, floating :: M.Map a RationalRect -- ^ floating windows
} deriving (Show, Read, Eq)
-- | Visible workspaces, and their Xinerama screens.
-data Screen i l a sid sd = Screen { workspace :: !(Workspace i l a)
+data Screen i l a sid sd = Screen { screenWorkspace :: !(Workspace i l a)
+ , screenHidden :: [Workspace i l a]
, screen :: !sid
, screenDetail :: !sd }
deriving (Show, Read, Eq)
@@ -195,9 +195,9 @@ abort x = error $ "xmonad: StackSet: " ++ x
--
new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd
new l wids m | not (null wids) && length m <= length wids && not (null m)
- = StackSet cur visi unseen M.empty
- where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
- (cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ]
+ = StackSet cur visi M.empty
+ where (seen,_) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
+ (cur:visi) = [ Screen i [] s sd | (i, s, sd) <- zip3 seen [0..] m ]
-- now zip up visibles with their screen id
new _ _ _ = abort "non-positive argument to StackSet.new"
@@ -210,21 +210,13 @@ new _ _ _ = abort "non-positive argument to StackSet.new"
-- current.
view :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
-view i s
- | i == currentTag s = s -- current
+view i s = s { current = head s', visible = tail s' }
+ where
+ s' = map makeVisible (current s : visible s)
- | Just x <- L.find ((i==).tag.workspace) (visible s)
- -- if it is visible, it is just raised
- = s { current = x, visible = current s : L.deleteBy (equating screen) x (visible s) }
-
- | Just x <- L.find ((i==).tag) (hidden s) -- must be hidden then
- -- if it was hidden, it is raised on the xine screen currently used
- = s { current = (current s) { workspace = x }
- , hidden = workspace (current s) : L.deleteBy (equating tag) x (hidden s) }
-
- | otherwise = s -- not a member of the stackset
-
- where equating f = \x y -> f x == f y
+ makeVisible scr
+ | Just x <- L.find ((i==) . tag) (screenHidden scr) = scr { screenWorkspace = x, screenHidden = (screenWorkspace scr) : L.deleteBy ((==) `on` tag) x (screenHidden scr)}
+ | otherwise = scr
-- 'Catch'ing this might be hard. Relies on monotonically increasing
-- workspace tags defined in 'new'
@@ -240,14 +232,15 @@ view i s
-- swapped.
greedyView :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
-greedyView w ws
+{-greedyView w ws
| any wTag (hidden ws) = view w ws
| (Just s) <- L.find (wTag . workspace) (visible ws)
= ws { current = (current ws) { workspace = workspace s }
, visible = s { workspace = workspace (current ws) }
: L.filter (not . wTag . workspace) (visible ws) }
| otherwise = ws
- where wTag = (w == ) . tag
+ where wTag = (w == ) . tag-}
+greedyView = view
-- ---------------------------------------------------------------------
-- $xinerama
@@ -255,7 +248,7 @@ greedyView w ws
-- | Find the tag of the workspace visible on Xinerama screen 'sc'.
-- 'Nothing' if screen is out of bounds.
lookupWorkspace :: Eq s => s -> StackSet i l a s sd -> Maybe i
-lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible w, s == sc ]
+lookupWorkspace sc w = listToMaybe [ tag i | Screen i _ s _ <- current w : visible w, s == sc ]
-- ---------------------------------------------------------------------
-- $stackOperations
@@ -267,14 +260,14 @@ lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible
-- returning the result. It is like 'maybe' for the focused workspace.
--
with :: b -> (Stack a -> b) -> StackSet i l a s sd -> b
-with dflt f = maybe dflt f . stack . workspace . current
+with dflt f = maybe dflt f . stack . screenWorkspace . current
-- |
-- Apply a function, and a default value for 'Nothing', to modify the current stack.
--
modify :: Maybe (Stack a) -> (Stack a -> Maybe (Stack a)) -> StackSet i l a s sd -> StackSet i l a s sd
modify d f s = s { current = (current s)
- { workspace = (workspace (current s)) { stack = with d f s }}}
+ { screenWorkspace = (screenWorkspace (current s)) { stack = with d f s }}}
-- |
-- Apply a function to modify the current stack if it isn't empty, and we don't
@@ -379,7 +372,13 @@ screens s = current s : visible s
-- | Get a list of all workspaces in the 'StackSet'.
workspaces :: StackSet i l a s sd -> [Workspace i l a]
-workspaces s = workspace (current s) : map workspace (visible s) ++ hidden s
+workspaces s = concatMap screenWorkspaces $ (current s) : (visible s)
+
+screenWorkspaces :: Screen i l a sid sd -> [Workspace i l a]
+screenWorkspaces scr = screenWorkspace scr : screenHidden scr
+
+hidden :: StackSet i l a s sd -> [Workspace i l a]
+hidden = concatMap screenHidden . screens
-- | Get a list of all windows in the 'StackSet' in no particular order
allWindows :: Eq a => StackSet i l a s sd -> [a]
@@ -387,7 +386,7 @@ allWindows = L.nub . concatMap (integrate' . stack) . workspaces
-- | Get the tag of the currently focused workspace.
currentTag :: StackSet i l a s sd -> i
-currentTag = tag . workspace . current
+currentTag = tag . screenWorkspace . current
-- | Is the given tag present in the 'StackSet'?
tagMember :: Eq i => i -> StackSet i l a s sd -> Bool
@@ -401,25 +400,24 @@ renameTag o n = mapWorkspace rename
-- | Ensure that a given set of workspace tags is present by renaming
-- existing workspaces and\/or creating new hidden workspaces as
-- necessary.
-ensureTags :: Eq i => l -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
+{-ensureTags :: Eq i => l -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
ensureTags l allt st = et allt (map tag (workspaces st) \\ allt) st
where et [] _ s = s
et (i:is) rn s | i `tagMember` s = et is rn s
et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s })
- et (i:is) (r:rs) s = et is rs $ renameTag r i s
+ et (i:is) (r:rs) s = et is rs $ renameTag r i s-}
-- | Map a function on all the workspaces in the 'StackSet'.
mapWorkspace :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWorkspace f s = s { current = updScr (current s)
- , visible = map updScr (visible s)
- , hidden = map f (hidden s) }
- where updScr scr = scr { workspace = f (workspace scr) }
+ , visible = map updScr (visible s) }
+ where updScr scr = scr { screenWorkspace = f (screenWorkspace scr), screenHidden = map f (screenHidden scr) }
-- | Map a function on all the layouts in the 'StackSet'.
mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd
-mapLayout f (StackSet v vs hs m) = StackSet (fScreen v) (map fScreen vs) (map fWorkspace hs) m
+mapLayout f (StackSet v vs m) = StackSet (fScreen v) (map fScreen vs) m
where
- fScreen (Screen ws s sd) = Screen (fWorkspace ws) s sd
+ fScreen (Screen ws hd s sd) = Screen (fWorkspace ws) (map fWorkspace hd) s sd
fWorkspace (Workspace t l s) = Workspace t (f l) s
-- | /O(n)/. Is a window in the 'StackSet'?
@@ -483,11 +481,8 @@ delete w = sink w . delete' w
-- | Only temporarily remove the window from the stack, thereby not destroying special
-- information saved in the 'Stackset'
delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
-delete' w s = s { current = removeFromScreen (current s)
- , visible = map removeFromScreen (visible s)
- , hidden = map removeFromWorkspace (hidden s) }
+delete' w s = mapWorkspace removeFromWorkspace s
where removeFromWorkspace ws = ws { stack = stack ws >>= filter (/=w) }
- removeFromScreen scr = scr { workspace = removeFromWorkspace (workspace scr) }
------------------------------------------------------------------------
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 03:28:07 +0100