From 5784590478cbdb1d0853fcf50a1ac13602a51895 Mon Sep 17 00:00:00 2001
From: Devin Mullins <me@twifkak.com>
Date: Tue, 2 Oct 2007 23:24:07 +0200
Subject: add SwapWorkspaces (to reorder them on your number keys)

darcs-hash:20071002212407-78224-eef85cd29ff04e0d352aeba89273e67e57e2fa46.gz
---
 SwapWorkspaces.hs | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 52 insertions(+)
 create mode 100644 SwapWorkspaces.hs

(limited to 'SwapWorkspaces.hs')

diff --git a/SwapWorkspaces.hs b/SwapWorkspaces.hs
new file mode 100644
index 0000000..e1575dc
--- /dev/null
+++ b/SwapWorkspaces.hs
@@ -0,0 +1,52 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonadContrib.SwapWorkspaces
+-- Copyright   :  (c) Devin Mullins <me@twifkak.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Devin Mullins <me@twifkak.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Lets you swap workspace tags, so you can keep related ones next to
+-- each other, without having to move individual windows.
+--
+-- TODO: add quickcheck props for:
+--       * double swap invariant (guarantees no 'loss' of workspaces)
+--       * non-swapped ws's invariant
+--
+-----------------------------------------------------------------------------
+
+module XMonadContrib.SwapWorkspaces (
+                                     -- * Usage
+                                     -- $usage
+                                     swapWithCurrent,
+                                     swapWorkspaces
+                                    ) where
+
+import StackSet
+
+-- $usage
+-- Add this import to your Config.hs:
+-- > import XMonadContrib.SwapWorkspaces
+--
+-- Throw this in your keys definition:
+-- > ++
+-- > [((modMask .|. controlMask, k), windows $ swapWithCurrent i)
+-- >     | (i, k) <- zip workspaces [xK_1 ..]]
+
+swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd
+swapWithCurrent t s = swapWorkspaces t (tag $ workspace $ current s) s
+
+-- Stole this from StackSet.renameTag -- extracted the traversal code they have in common as mapWorkspaces
+swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
+swapWorkspaces t1 t2 = mapWorkspaces swap
+    where swap w = if      tag w == t1 then w { tag = t2 }
+                   else if tag w == t2 then w { tag = t1 }
+                   else w
+
+mapWorkspaces :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd
+mapWorkspaces 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 }
-- 
cgit v1.2.3