Document and extend BoringWindows to support multiple sources of boring.

Ignore-this: 7375c8912ede6a6a44db4a4b91ffbc33

The Replace and Merge messages are added to support layouts sending a list of
windows that should be skipped over. The sources are tagged by a string key, so
it is possible though unlikely for different sources of boring windows to
interfere with eachother.

darcs-hash:20090406041301-1499c-a7496446b134bfbf4ab867bf110a7386559bb3cc.gz

1 files changed, 90 insertions, 31 deletions

diff --git a/XMonad/Layout/BoringWindows.hs b/XMonad/Layout/BoringWindows.hs
index 54d7b91..f56a004 100644
--- a/XMonad/Layout/BoringWindows.hs
+++ b/XMonad/Layout/BoringWindows.hs
@@ -1,5 +1,5 @@
-{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
-
+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
+{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.BoringWindows
@@ -15,51 +15,110 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Layout.BoringWindows (
-                                   boringWindows,
+                                   -- * Usage
+                                   -- $usage
+                                   boringWindows, boringAuto,
                                    markBoring, clearBoring,
-                                   focusUp, focusDown
+                                   focusUp, focusDown,
+
+                                   UpdateBoring(UpdateBoring),
+                                   BoringMessage(Replace,Merge),
+                                   BoringWindows()
                                   ) where
 
-import XMonad hiding (Point)
+import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
+                                    LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))
+import XMonad(Typeable, LayoutClass, Message, X, fromMessage,
+              sendMessage, windows, withFocused, Window)
+import Control.Applicative((<$>))
+import Control.Monad(Monad(return, (>>)))
+import Data.List((\\), union)
+import Data.Maybe(Maybe(..), maybe, fromMaybe, listToMaybe,
+                  maybeToList)
+import qualified Data.Map as M
 import qualified XMonad.StackSet as W
-import XMonad.Layout.LayoutModifier
-import XMonad.Util.Invisible
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.BoringWindows
+--
+-- Then edit your @layoutHook@ by adding the layout modifier:
+--
+-- > myLayouts = boringWindows (Full ||| etc..)
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- Then to your keybindings, add:
+--
+-- > , ((modMask, xK_j), focusUp)
+-- > , ((modMask, xk_k), focusDown)
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
 
 data BoringMessage = FocusUp | FocusDown | IsBoring Window | ClearBoring
-                       deriving ( Read, Show, Typeable )
+                     | Replace String [Window]
+                     | Merge String [Window]
+                     deriving ( Read, Show, Typeable )
+
 instance Message BoringMessage
 
+-- | UpdateBoring is sent before attempting to view another boring window, so
+-- that layouts have a chance to mark boring windows.
+data UpdateBoring = UpdateBoring
+    deriving (Typeable)
+instance Message UpdateBoring
+
 markBoring, clearBoring, focusUp, focusDown :: X ()
 markBoring = withFocused (sendMessage . IsBoring)
 clearBoring = sendMessage ClearBoring
-focusUp = sendMessage FocusUp
-focusDown = sendMessage FocusDown
+focusUp = sendMessage UpdateBoring >> sendMessage FocusUp
+focusDown = sendMessage UpdateBoring >> sendMessage FocusDown
 
-data BoringWindows a = BoringWindows (Invisible [] a) deriving ( Show, Read, Typeable )
+data BoringWindows a = BoringWindows
+    { namedBoring :: M.Map String [a] -- ^ store borings with a specific source
+    , chosenBoring :: [a]             -- ^ user-chosen borings
+    , hiddenBoring :: Maybe [a]       -- ^ maybe mark hidden windows
+    } deriving (Show,Read,Typeable)
 
 boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
-boringWindows = ModifiedLayout (BoringWindows (I []))
+boringWindows = ModifiedLayout (BoringWindows M.empty [] Nothing)
+
+-- | Mark windows that are not given rectangles as boring
+boringAuto :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
+boringAuto = ModifiedLayout (BoringWindows M.empty [] (Just []))
 
 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
+    redoLayout (b@BoringWindows { hiddenBoring = bs }) _r mst arrs = do
+        let bs' = W.integrate' mst \\ map fst arrs
+        return (arrs, Just $ b { hiddenBoring = const bs' <$> bs } )
+
+    handleMessOrMaybeModifyIt bst@(BoringWindows nbs cbs lbs) m
+        | Just (Replace k ws) <- fromMessage m
+        , maybe True (ws/=) (M.lookup k nbs) =
+            let nnb = if null ws then M.delete k nbs
+                          else M.insert k ws nbs
+            in rjl bst { namedBoring = nnb }
+        | Just (Merge k ws) <- fromMessage m
+        , maybe True (not . null . (ws \\)) (M.lookup k nbs) =
+            rjl bst { namedBoring = M.insertWith union k ws nbs }
+        | Just (IsBoring w) <- fromMessage m , w `notElem` cbs =
+            rjl bst { chosenBoring = w:cbs }
+        | Just ClearBoring <- fromMessage m, not (null cbs) =
+            rjl bst { namedBoring = M.empty, chosenBoring = []}
+        | Just FocusUp <- fromMessage m =
+                            do windows $ W.modify' $ skipBoring W.focusUp'
+                               return Nothing
         | Just FocusDown <- fromMessage m =
-                            do windows $ W.modify' (reverseStack . focusUp' . reverseStack)
+                            do windows $ W.modify' $ skipBoring W.focusDown'
                                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)
+        where skipBoring f st = fromMaybe st $ listToMaybe
+                                $ filter ((`notElem` W.focus st:bs) . W.focus)
+                                $ take (length $ W.integrate st)
+                                $ iterate f st
+              bs = concat $ cbs:maybeToList lbs ++ M.elems nbs
+              rjl = return . Just . Left
     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