aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Actions
diff options
context:
space:
mode:
authorBrent Yorgey <byorgey@cis.upenn.edu>2009-12-30 20:23:50 +0100
committerBrent Yorgey <byorgey@cis.upenn.edu>2009-12-30 20:23:50 +0100
commitee75bd64b12836282940be3a91227fcd7e5b8fb9 (patch)
tree126ac416659d6e10f3379cbe580dd697eacfa308 /XMonad/Actions
parent40b3897f959ae292c60a52d563e62fd21a40022a (diff)
downloadXMonadContrib-ee75bd64b12836282940be3a91227fcd7e5b8fb9.tar.gz
XMonadContrib-ee75bd64b12836282940be3a91227fcd7e5b8fb9.tar.xz
XMonadContrib-ee75bd64b12836282940be3a91227fcd7e5b8fb9.zip
import new contrib module, X.A.DynamicWorkspaceOrder
Ignore-this: bba2c0c30d5554612cc6e8bd59fee205 darcs-hash:20091230192350-1e371-612ae7cfbae4dcd7af436add198c2746d3abd05c.gz
Diffstat (limited to 'XMonad/Actions')
-rw-r--r--XMonad/Actions/DynamicWorkspaceOrder.hs166
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