From d444f374b6904bde4a10531f0161f367c8b54fb1 Mon Sep 17 00:00:00 2001
From: David Roundy <droundy@darcs.net>
Date: Tue, 14 Aug 2007 03:15:01 +0200
Subject: new module DynamicWorkspaces to add and remove workspaces.

darcs-hash:20070814011501-72aca-10aa9dd1a14ac1179f8cc16ebd52b1e54a505df8.gz
---
 DynamicWorkspaces.hs | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 52 insertions(+)
 create mode 100644 DynamicWorkspaces.hs

(limited to 'DynamicWorkspaces.hs')

diff --git a/DynamicWorkspaces.hs b/DynamicWorkspaces.hs
new file mode 100644
index 0000000..0f417bb
--- /dev/null
+++ b/DynamicWorkspaces.hs
@@ -0,0 +1,52 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonadContrib.DynamicWorkspaces
+-- Copyright   :  (c) David Roundy <droundy@darcs.net>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides bindings to add and delete workspaces.  Note that you may only
+-- delete a workspace that is already empty.
+--
+-----------------------------------------------------------------------------
+
+module XMonadContrib.DynamicWorkspaces (
+                                         -- * Usage
+                                         -- $usage
+                                         addWorkspace, removeWorkspace
+                                       ) where
+
+import XMonad ( X )
+import Operations ( windows )
+import StackSet ( tagMember, StackSet(..), Screen(..), Workspace(..) )
+
+-- $usage
+-- You can use this module with the following in your Config.hs file:
+-- 
+-- > import XMonadContrib.DynamicWorkspaces
+--
+-- >   , ((modMask .|. shiftMask, xK_Up), addWorkspace)
+-- >   , ((modMask .|. shiftMask, xK_Down), removeWorkspace)
+
+addWorkspace :: X ()
+addWorkspace = windows addWorkspace'
+
+removeWorkspace :: X ()
+removeWorkspace = windows removeWorkspace'
+
+addWorkspace' :: (Enum i, Num i) => StackSet i a sid sd -> StackSet i a sid sd
+addWorkspace' s@(StackSet { current = scr@(Screen { workspace = w })
+                          , hidden = ws })
+    = s { current = scr { workspace = Workspace newtag Nothing }
+        , hidden = w:ws }
+    where (newtag:_) = filter (not . (`tagMember` s)) [0..]
+
+removeWorkspace' :: StackSet i a sid sd -> StackSet i a sid sd
+removeWorkspace' s@(StackSet { current = scr@(Screen { workspace = Workspace { stack = Nothing } })
+                             , hidden = (w:ws) })
+                    = s { current = scr { workspace = w }
+                        , hidden = ws }
+removeWorkspace' s = s
-- 
cgit v1.2.3