diff options
Diffstat (limited to 'XMonad')
| -rw-r--r-- | XMonad/Actions/DynamicWorkspaceOrder.hs | 166 |
1 files changed, 166 insertions, 0 deletions
diff --git a/XMonad/Actions/DynamicWorkspaceOrder.hs b/XMonad/Actions/DynamicWorkspaceOrder.hs new file mode 100644 index 0000000..af46016 --- /dev/null +++ b/XMonad/Actions/DynamicWorkspaceOrder.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.DynamicWorkspaceOrder +-- Copyright : (c) Brent Yorgey 2009 +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : <byorgey@gmail.com> +-- Stability : experimental +-- Portability : unportable +-- +-- Remember a dynamically updateable ordering on workspaces, together +-- with tools for using this ordering with "XMonad.Actions.CycleWS" +-- and "XMonad.Hooks.DynamicLog". +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.DynamicWorkspaceOrder + ( -- * Usage + -- $usage + + getWsCompareByOrder + , getSortByOrder + , swapWith + + , moveTo + , moveToGreedy + , shiftTo + + ) where + +import XMonad +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS + +import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort) +import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo) + +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Maybe (fromJust, fromMaybe) +import Data.Ord (comparing) +import Data.Typeable + +-- $usage +-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- +-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO +-- +-- Then add keybindings to swap the order of workspaces (these +-- examples use "XMonad.Util.EZConfig" emacs-style keybindings): +-- +-- > , ("M-C-<R>", DO.swapWith Next NonEmptyWS) +-- > , ("M-C-<L>", DO.swapWith Prev NonEmptyWS) +-- +-- See "XMonad.Actions.CycleWS" for information on the possible +-- arguments to 'swapWith'. +-- +-- However, by itself this will do nothing; 'swapWith' does not change +-- the actual workspaces in any way. It simply keeps track of an +-- auxiliary ordering on workspaces. Anything which cares about the +-- order of workspaces must be updated to use the auxiliary ordering. +-- +-- To change the order in which workspaces are displayed by +-- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your +-- 'XMonad.Hooks.DynamicLog.ppSort' field, for example: +-- +-- > ... dynamicLogWithPP $ byorgeyPP { +-- > ... +-- > , ppSort = DO.getSortByOrder +-- > ... +-- > } +-- +-- To use workspace cycling commands like those from +-- "XMonad.Actions.CycleWS", use the versions of 'moveTo', +-- 'moveToGreedy', and 'shiftTo' exported by this module. For example: +-- +-- > , ("M-S-<R>", DO.shiftTo Next HiddenNonEmptyWS) +-- > , ("M-S-<L>", DO.shiftTo Prev HiddenNonEmptyWS) +-- > , ("M-<R>", DO.moveTo Next HiddenNonEmptyWS) +-- > , ("M-<L>", DO.moveTo Prev HiddenNonEmptyWS) +-- +-- For slight variations on these, use the source for examples and +-- tweak as desired. + +-- | Extensible state storage for the workspace order. +data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) } + deriving (Typeable, Read, Show) + +instance ExtensionClass WSOrderStorage where + initialValue = WSO Nothing + extensionType = PersistentExtension + +-- | Lift a Map function to a function on WSOrderStorage. +withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int) + -> (WSOrderStorage -> WSOrderStorage) +withWSO f = WSO . fmap f . unWSO + +-- | Update the ordering storage: initialize if it doesn't yet exist; +-- add newly created workspaces at the end as necessary. +updateOrder :: X () +updateOrder = do + WSO mm <- XS.get + case mm of + Nothing -> do + -- initialize using ordering of workspaces from the user's config + ws <- asks (workspaces . config) + XS.put . WSO . Just . M.fromList $ zip ws [0..] + Just m -> do + -- check for new workspaces and add them at the end + curWs <- gets (S.fromList . map W.tag . W.workspaces . windowset) + let mappedWs = M.keysSet m + newWs = curWs `S.difference` mappedWs + nextIndex = 1 + maximum (-1 : M.elems m) + newWsIxs = zip (S.toAscList newWs) [nextIndex..] + XS.modify . withWSO . M.union . M.fromList $ newWsIxs + +-- | A comparison function which orders workspaces according to the +-- stored dynamic ordering. +getWsCompareByOrder :: X WorkspaceCompare +getWsCompareByOrder = do + updateOrder + -- after the call to updateOrder we are guaranteed that the dynamic + -- workspace order is initialized and contains all existing + -- workspaces. + WSO (Just m) <- XS.get + return $ comparing (fromMaybe 1000 . flip M.lookup m) + +-- | Sort workspaces according to the stored dynamic ordering. +getSortByOrder :: X WorkspaceSort +getSortByOrder = mkWsSort getWsCompareByOrder + +-- | Swap the current workspace with another workspace in the stored +-- dynamic order. +swapWith :: Direction1D -> WSType -> X () +swapWith dir which = findWorkspace getSortByOrder dir which 1 >>= swapWithCurrent + +-- | Swap the given workspace with the current one. +swapWithCurrent :: WorkspaceId -> X () +swapWithCurrent w = do + cur <- gets (W.currentTag . windowset) + swapOrder w cur + +-- | Swap the two given workspaces in the dynamic order. +swapOrder :: WorkspaceId -> WorkspaceId -> X () +swapOrder w1 w2 = do + io $ print (w1,w2) + WSO (Just m) <- XS.get + let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2] + XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1)) + windows id -- force a status bar update + +-- | View the next workspace of the given type in the given direction, +-- where \"next\" is determined using the dynamic workspace order. +moveTo :: Direction1D -> WSType -> X () +moveTo dir t = doTo dir t getSortByOrder (windows . W.view) + +-- | Same as 'moveTo', but using 'greedyView' instead of 'view'. +moveToGreedy :: Direction1D -> WSType -> X () +moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView) + +-- | Shift the currently focused window to the next workspace of the +-- given type in the given direction, using the dynamic workspace order. +shiftTo :: Direction1D -> WSType -> X () +shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
\ No newline at end of file |