From 7e0f52f24712116bc393a806efdb40c25cef3628 Mon Sep 17 00:00:00 2001 From: Adam Vogt Date: Wed, 25 Mar 2009 06:02:06 +0100 Subject: More configurability for Layout.NoBorders (typeclass method) Ignore-this: 91fe0bc6217b910b7348ff497b922e11 This method uses a typeclass to pass a function to the layoutmodifier. It is flexible, but a bit indirect and perhaps the flexibility is not required. darcs-hash:20090325050206-1499c-fd29296b7092e7a437a1cec5d5bf35265324952e.gz --- XMonad/Layout/NoBorders.hs | 154 +++++++++++++++++++++++++++++++++++---------- 1 file changed, 122 insertions(+), 32 deletions(-) diff --git a/XMonad/Layout/NoBorders.hs b/XMonad/Layout/NoBorders.hs index ec6d6e7..4a5ff5a 100644 --- a/XMonad/Layout/NoBorders.hs +++ b/XMonad/Layout/NoBorders.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | @@ -22,15 +23,20 @@ module XMonad.Layout.NoBorders ( -- $usage noBorders, smartBorders, - withBorder + withBorder, + lessBorders, + SetsAmbiguous(..), + Ambiguity(..), + With(..) ) where import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W -import Data.Maybe(isJust) -import Data.List ((\\)) +import Control.Monad +import Data.List import qualified Data.Map as M +import Data.Function (on) -- $usage -- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file: @@ -71,34 +77,10 @@ withBorder b = ModifiedLayout $ WithBorder b [] setBorders :: [Window] -> Dimension -> X () setBorders ws bw = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws -data SmartBorder a = SmartBorder [a] deriving (Read, Show) - -instance LayoutModifier SmartBorder Window where - unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s - - redoLayout (SmartBorder s) _ mst wrs = do - wset <- gets windowset - let managedwindows = W.integrate' mst - screens = [ scr | scr <- W.screens wset, - isJust . W.stack $ W.workspace scr, - nonzerorect . screenRect $ W.screenDetail scr] - ws = tiled ++ floating - tiled = case filter (`elem` managedwindows) $ map fst wrs of - [w] | singleton screens -> [w] - _ -> [] - floating = - [ w | - (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset, - px <= 0, py <= 0, - wx + px >= 1, wy + py >= 1 - ] - asks (borderWidth . config) >>= setBorders (s \\ ws) - setBorders ws 0 - return (wrs, Just $ SmartBorder ws) - where - singleton = null . drop 1 - nonzerorect (Rectangle _ _ 0 0) = False - nonzerorect _ = True +singleton :: [a] -> Bool +singleton = null . drop 1 + +type SmartBorder = ConfigurableBorder Ambiguity -- | Removes the borders from a window under one of the following conditions: -- @@ -108,4 +90,112 @@ instance LayoutModifier SmartBorder Window where -- * A floating window covers the entire screen (e.g. mplayer). -- smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a -smartBorders = ModifiedLayout (SmartBorder []) +smartBorders = lessBorders Never + +-- | Apply a datatype that has a SetsAmbiguous instance to provide a list of +-- windows that should not have borders. +-- +-- This gives flexibility over when borders should be drawn, in particular with +-- xinerama setups: 'Ambiguity' has a number of useful 'SetsAmbiguous' +-- instances +lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) => + p -> l a -> ModifiedLayout (ConfigurableBorder p) l a +lessBorders amb = ModifiedLayout (ConfigurableBorder amb []) + +data ConfigurableBorder p w = ConfigurableBorder p [w] deriving (Read, Show) + +instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where + unhook (ConfigurableBorder _p s) = asks (borderWidth . config) >>= setBorders s + + redoLayout (ConfigurableBorder p s) _ mst wrs = do + ws <- withWindowSet (\wset -> return (hiddens p wset mst wrs)) + asks (borderWidth . config) >>= setBorders (s \\ ws) + setBorders ws 0 + return (wrs, Just $ ConfigurableBorder p ws) + +-- | SetsAmbiguous allows custom actions to generate lists of windows that +-- should not have borders drawn through 'ConfigurableBorder' +-- +-- To add your own (though perhaps those options would better belong as an +-- aditional constructor to 'Ambiguity'), you can add the function as such: +-- +-- > data MyAmbiguity = MyAmbiguity deriving (Read, Show) +-- +-- > instance SetsAmbiguous MyAmbiguity where +-- > hiddens _ wset mst wrs = otherHiddens Screen \\ otherHiddens OnlyFloat +-- > where otherHiddens p = hiddens p wset mst wrs +-- +-- The above example is redundant, because you can have the same result with: +-- +-- > layoutHook = lessBorders (Combine Difference Screen OnlyFloat) (Tall 1 0.5 0.03 ||| ... ) +-- +-- To get the same result as smartBorders: +-- +-- > layoutHook = lessBorders (Combine Never) (Tall 1 0.5 0.03 ||| ...) +-- +-- This indirect method is required to keep the Read and Show for +-- ConfigurableBorder so that xmonad can serialize state. +class SetsAmbiguous p where + hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window] + +instance SetsAmbiguous Ambiguity where + hiddens amb wset mst wrs + | Combine Union a b <- amb = on union next a b + | Combine Difference a b <- amb = on (\\) next a b + | Combine Intersection a b <- amb = on intersect next a b + | otherwise = tiled ms ++ floating + where next p = hiddens p wset mst wrs + nonzerorect (Rectangle _ _ 0 0) = False + nonzerorect _ = True + + screens = + [ scr | scr <- W.screens wset, + case amb of + Never -> True + _ -> not $ null $ integrate scr, + nonzerorect . screenRect $ W.screenDetail scr] + floating = [ w | + (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset, + px <= 0, py <= 0, + wx + px >= 1, wy + py >= 1] + ms = filter (`elem` W.integrate' mst) $ map fst wrs + tiled [w] + | Screen <- amb = [w] + | OnlyFloat <- amb = [] + | OtherIndicated <- amb + , let nonF = map integrate $ W.current wset : W.visible wset + , length (concat nonF) > length wrs + , singleton $ filter (1==) $ map length nonF = [w] + | singleton screens = [w] + tiled _ = [] + integrate y = W.integrate' . W.stack $ W.workspace y + +-- | In order of increasing ambiguity (less borders more frequently), where +-- subsequent constructors add additional cases where borders are not drawn +-- than their predecessors. These behaviors make most sense with with multiple +-- screens: for single screens, Never or 'smartBorders' makes more sense. +data Ambiguity = Combine With Ambiguity Ambiguity + -- ^ This constructor is used to combine the + -- borderless windows provided by the + -- SetsAmbiguous instances from two other + -- 'Ambiguity' data types. + | OnlyFloat -- ^ Only remove borders on floating windows that + -- cover the whole screen + | Never -- ^ Never remove borders when ambiguous: + -- this is the same as smartBorders + | EmptyScreen -- ^ Focus in an empty screens does not count as + -- ambiguous. + | OtherIndicated + -- ^ No borders on full when all other screens + -- have borders. + | Screen -- ^ Borders are never drawn on singleton screens. + -- With this one you really need another way such + -- as a statusbar to detect focus. + deriving (Read, Show) + +-- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two +-- lists should be combined. +data With = Union -- ^ Combine with Data.List.union + | Difference -- ^ Combine with Data.List.\\ + | Intersection -- ^ Combine with Data.List.intersect + deriving (Read, Show) -- cgit v1.2.3