1 files changed, 66 insertions, 0 deletions
diff --git a/XMonad/Layout/BoringWindows.hs b/XMonad/Layout/BoringWindows.hs
new file mode 100644
index 0000000..d66aa73
--- /dev/null
+++ b/XMonad/Layout/BoringWindows.hs
@@ -0,0 +1,66 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.BoringWindows
+-- Copyright   :  (c) 2008  David Roundy <droundy@darcs.net>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- BoringWindows is an extension to allow windows to be marked boring
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.BoringWindows (
+                                   -- * Usage
+                                   -- $usage
+                                   boringWindows,
+                                   markBoring, clearBoring,
+                                   focusUp, focusDown
+                                  ) where
+
+import XMonad hiding (Point)
+import qualified XMonad.StackSet as W
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.Invisible
+
+data BoringMessage = FocusUp | FocusDown | IsBoring Window | ClearBoring
+                       deriving ( Read, Show, Typeable )
+instance Message BoringMessage
+
+markBoring = withFocused (sendMessage . IsBoring)
+clearBoring = sendMessage ClearBoring
+focusUp = sendMessage FocusUp
+focusDown = sendMessage FocusDown
+
+data BoringWindows a = BoringWindows (Invisible [] a) deriving ( Show, Read, Typeable )
+
+boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
+boringWindows = ModifiedLayout (BoringWindows (I []))
+
+instance LayoutModifier BoringWindows Window where
+    handleMessOrMaybeModifyIt (BoringWindows (I bs)) m
+        | Just (IsBoring b) <- fromMessage m = return $ Just $ Left $ BoringWindows (I (b:bs))
+        | Just ClearBoring <- fromMessage m = return $ Just $ Left $ BoringWindows (I [])
+        | Just FocusUp <- fromMessage m = do windows $ W.modify' $ focusUp'
+                                             return Nothing
+        | Just FocusDown <- fromMessage m =
+                            do windows $ W.modify' (reverseStack . focusUp' . reverseStack)
+                               return Nothing
+        where focusUp' (W.Stack t ls rs)
+                  | (a,l:ls') <- skipBoring ls = W.Stack l ls' (a++t:rs)
+                  | otherwise = case skipBoring (reverse (t:rs)++ls) of
+                                (a,x:xs) -> W.Stack x xs a
+                                _ -> W.Stack t ls rs
+              skipBoring [] = ([],[])
+              skipBoring (x:xs) | x `elem` bs = case skipBoring xs of
+                                                (a,b) -> (x:a,b)
+                                | otherwise = ([],x:xs)
+    handleMessOrMaybeModifyIt _ _ = return Nothing
+
+-- | reverse a stack: up becomes down and down becomes up.
+reverseStack :: W.Stack a -> W.Stack a
+reverseStack (W.Stack t ls rs) = W.Stack t rs ls