From 67af43c814819f0c836f796b6f1c61cc446143df Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Fri, 1 Feb 2008 13:04:30 +0100 Subject: WorkspaceCompare: some refactoring. * Export WorkspaceCompare and WorkspaceSort types. * Extract commonality in sort methods into mkWsSort, which creates a workspace sort from a workspace comparison function. * Rename getSortByTag to getSortByIndex, since it did not actually sort by tag at all; it sorts by index of workspace tags in the user's config. * Create a new getSortByTag function which actually does sort lexicographically by tag. * Enhance documentation. darcs-hash:20080201120430-bd4d7-71310db2b8d4248ddfb77e3fa25dd0f3b98ea00b.gz --- XMonad/Hooks/DynamicLog.hs | 6 ++--- XMonad/Hooks/EwmhDesktops.hs | 12 ++++----- XMonad/Util/WorkspaceCompare.hs | 59 +++++++++++++++++++++++++++++------------ 3 files changed, 51 insertions(+), 26 deletions(-) (limited to 'XMonad') diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs index ecc4891..def78e7 100644 --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -268,7 +268,7 @@ defaultPP = PP { ppCurrent = wrap "[" "]" , ppLayout = id , ppOrder = id , ppOutput = putStrLn - , ppSort = getSortByTag + , ppSort = getSortByIndex } -- | Settings to emulate dwm's statusbar, dzen only. @@ -305,10 +305,10 @@ byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces , ppUrgent = dzenColor "red" "yellow" , ppSep = " | " , ppWsSep = "" - , ppTitle = shorten 65 + , ppTitle = shorten 70 , ppOrder = reverse } - where showNamedWorkspaces wsId = if (':' `elem` wsId) + where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z'] then pad wsId else "" diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index 231525d..5a3d030 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -38,17 +38,17 @@ import XMonad.Util.WorkspaceCompare -- > return () -- > -- > main = xmonad defaultConfig { logHook = myLogHook } --- +-- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" --- | +-- | -- Notifies pagers and window lists, such as those in the gnome-panel -- of the current state of workspaces and windows. ewmhDesktopsLogHook :: X () ewmhDesktopsLogHook = withWindowSet $ \s -> do - sort' <- getSortByTag + sort' <- getSortByIndex let ws = sort' $ W.workspaces s let wins = W.allWindows s @@ -62,7 +62,7 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do -- Current desktop let curr = fromJust $ elemIndex (W.tag (W.workspace (W.current s))) $ map W.tag ws - + setCurrentDesktop curr setClientList wins @@ -70,11 +70,11 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do -- Per window Desktop -- To make gnome-panel accept our xinerama stuff, we display -- all visible windows on the current desktop. - forM_ (W.current s : W.visible s) $ \x -> + forM_ (W.current s : W.visible s) $ \x -> forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do setWindowDesktop win curr - forM_ (W.hidden s) $ \w -> + forM_ (W.hidden s) $ \w -> let wn = fromJust $ elemIndex (W.tag w) (map W.tag ws) in forM_ (W.integrate' (W.stack w)) $ \win -> do setWindowDesktop win wn diff --git a/XMonad/Util/WorkspaceCompare.hs b/XMonad/Util/WorkspaceCompare.hs index 3517100..fbf139d 100644 --- a/XMonad/Util/WorkspaceCompare.hs +++ b/XMonad/Util/WorkspaceCompare.hs @@ -9,8 +9,13 @@ -- Portability : unportable -- -module XMonad.Util.WorkspaceCompare ( getWsIndex +module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort + , getWsIndex , getWsCompare + , getWsCompareByTag + , getXineramaWsCompare + , mkWsSort + , getSortByIndex , getSortByTag , getSortByXineramaRule ) where @@ -21,6 +26,9 @@ import Data.Monoid import Data.Ord import Data.Maybe +type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering +type WorkspaceSort = [WindowSpace] -> [WindowSpace] + -- | Lookup the index of a workspace id in the user's config, return Nothing -- if that workspace does not exist in the config. getWsIndex :: X (WorkspaceId -> Maybe Int) @@ -28,8 +36,9 @@ getWsIndex = do spaces <- asks (workspaces . config) return $ flip elemIndex spaces --- | A comparison function for WorkspaceId -getWsCompare :: X (WorkspaceId -> WorkspaceId -> Ordering) +-- | A comparison function for WorkspaceId, based on the index of the +-- tags in the user's config. +getWsCompare :: X WorkspaceCompare getWsCompare = do wsIndex <- getWsIndex return $ \a b -> f (wsIndex a) (wsIndex b) `mappend` compare a b @@ -39,9 +48,15 @@ getWsCompare = do f Nothing (Just _) = GT f (Just x) (Just y) = compare x y --- | A comparison function for Xinerama based on visibility, workspace and --- screen id. It produces same ordering as pprWindowSetXinerama does. -getXineramaWsCompare :: X(WorkspaceId -> WorkspaceId -> Ordering) +-- | A simple comparison function that orders workspaces +-- lexicographically by tag. +getWsCompareByTag :: X WorkspaceCompare +getWsCompareByTag = return compare + +-- | A comparison function for Xinerama based on visibility, workspace +-- and screen id. It produces the same ordering as +-- 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama'. +getXineramaWsCompare :: X WorkspaceCompare getXineramaWsCompare = do w <- gets windowset return $ \ a b -> case (isOnScreen a w, isOnScreen b w) of @@ -53,17 +68,27 @@ getXineramaWsCompare = do onScreen w = S.current w : S.visible w isOnScreen a w = a `elem` map (S.tag . S.workspace) (onScreen w) tagToSid s x = S.screen $ fromJust $ find ((== x) . S.tag . S.workspace) s - --S.screen $ head $ filter ((== x) . S.tag . S.workspace) s --- | Sort several workspaces according to the order in getWsCompare -getSortByTag :: X ([WindowSpace] -> [WindowSpace]) -getSortByTag = do - cmp <- getWsCompare - return $ sortBy (\a b -> cmp (S.tag a) (S.tag b)) +-- | Create a workspace sorting function from a workspace comparison +-- function. +mkWsSort :: X WorkspaceCompare -> X WorkspaceSort +mkWsSort cmpX = do + cmp <- cmpX + return $ sortBy (\a b -> cmp (S.tag a) (S.tag b)) + +-- | Sort several workspaces according to their tags' indices in the +-- user's config. +getSortByIndex :: X WorkspaceSort +getSortByIndex = mkWsSort getWsCompare + +-- | Sort workspaces lexicographically by tag. +getSortByTag :: X WorkspaceSort +getSortByTag = mkWsSort getWsCompareByTag --- | Sort serveral workspaces for xinerama displays -getSortByXineramaRule :: X ([WindowSpace] -> [WindowSpace]) -getSortByXineramaRule = do - cmp <- getXineramaWsCompare - return $ sortBy (\a b -> cmp (S.tag a) (S.tag b)) +-- | Sort serveral workspaces for xinerama displays, in the same order +-- produced by 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama': first +-- visible workspaces, sorted by screen, then hidden workspaces, +-- sorted by tag. +getSortByXineramaRule :: X WorkspaceSort +getSortByXineramaRule = mkWsSort getXineramaWsCompare -- cgit v1.2.3