summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/ConfigurableBorders.hs84
-rw-r--r--lib/FullscreenManager.hs138
-rw-r--r--lib/NoBorders.hs214
3 files changed, 436 insertions, 0 deletions
diff --git a/lib/ConfigurableBorders.hs b/lib/ConfigurableBorders.hs
new file mode 100644
index 0000000..ea64a04
--- /dev/null
+++ b/lib/ConfigurableBorders.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards, DeriveDataTypeable #-}
+
+module ConfigurableBorders ( configureBorders
+ , configBorderWidth
+ , resetBorderWidth
+ , doConfigBorderWidth
+ , doConfigBorderOff
+ ) where
+
+
+import qualified XMonad.Core as XM
+import XMonad.Operations (sendMessage)
+import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
+import Graphics.X11.Types (Window)
+import Graphics.X11.Xlib.Types (Dimension)
+import Graphics.X11.Xlib.Window (setWindowBorderWidth)
+
+import Control.Monad.Reader
+
+import Data.Monoid
+import Data.Typeable
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+
+defaultBorderWidth :: XM.X Dimension
+defaultBorderWidth = asks (XM.borderWidth . XM.config)
+
+
+data BorderWidth = BorderWidth Window Dimension deriving Typeable
+
+instance XM.Message BorderWidth
+
+
+configBorderWidth :: Dimension -> Window -> XM.X ()
+configBorderWidth w win = sendMessage $ BorderWidth win w
+
+resetBorderWidth :: Window -> XM.X ()
+resetBorderWidth win = do
+ defBW <- defaultBorderWidth
+ configBorderWidth defBW win
+
+doConfigBorderWidth :: Dimension -> XM.ManageHook
+doConfigBorderWidth w = XM.Query $ do
+ win <- ask
+ lift $ configBorderWidth w win
+ return $ Endo id
+
+doConfigBorderOff :: XM.ManageHook
+doConfigBorderOff = doConfigBorderWidth 0
+
+
+data ConfigureBorders a = ConfigureBorders (M.Map a Dimension) (M.Map a Dimension)
+ deriving (Show, Read)
+
+configureBorders :: (XM.LayoutClass l a) =>
+ l a
+ -> ModifiedLayout ConfigureBorders l a
+configureBorders = ModifiedLayout $ ConfigureBorders M.empty M.empty
+
+
+instance LayoutModifier ConfigureBorders Window where
+ modifierDescription _ = "ConfigureBorders"
+
+ pureMess (ConfigureBorders wm wmlast) m
+ | Just (BorderWidth win width) <- XM.fromMessage m = do
+ let wmnew = M.insert win width wm
+ return $ ConfigureBorders wmnew wmlast
+
+ pureMess _ _ = Nothing
+
+ redoLayout (ConfigureBorders wm wmlast) _ _ wrs = do
+ setBorders wmlast
+ return (wrs, Just $ ConfigureBorders M.empty wm)
+ where
+ ws = S.fromList $ map fst wrs
+
+
+setBorders :: (M.Map Window Dimension) -> XM.X ()
+setBorders wm = forM_ (M.toList wm) $ \(win,width) -> setBorder win width
+
+
+setBorder :: Window -> Dimension -> XM.X ()
+setBorder w width = XM.withDisplay $ \dpy -> XM.io $ setWindowBorderWidth dpy w width
diff --git a/lib/FullscreenManager.hs b/lib/FullscreenManager.hs
new file mode 100644
index 0000000..ac1907f
--- /dev/null
+++ b/lib/FullscreenManager.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards, DeriveDataTypeable #-}
+
+module FullscreenManager (
+ manageFullscreen,
+ handleFullscreen,
+ doFullscreen,
+ doFloatMaybeFullscreen,
+ setFullscreen,
+ unsetFullscreen,
+ setFullscreenFloat,
+ unsetFullscreenFloat
+ ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Hooks.ManageHelpers (isFullscreen)
+
+import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
+import Graphics.X11.Types (Window)
+
+import Control.Monad
+import Control.Monad.Trans
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+
+
+data SetFullscreen = SetFullscreen Window Bool Bool deriving Typeable
+
+instance Message SetFullscreen
+
+
+data FullscreenManager a = FullscreenManager (M.Map a W.RationalRect)
+ deriving (Show, Read)
+
+manageFullscreen :: (LayoutClass l a) =>
+ l a
+ -> ModifiedLayout FullscreenManager l a
+manageFullscreen = ModifiedLayout $ FullscreenManager M.empty
+
+
+instance LayoutModifier FullscreenManager Window where
+ modifierDescription _ = "FullscreenManager"
+
+ handleMess (FullscreenManager wm) m
+ | Just (SetFullscreen win fs ff) <- fromMessage m = do
+ let ptype = 4
+ state <- getAtom "_NET_WM_STATE"
+ fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
+ winstate <- withDisplay $ \dpy -> io $ getWindowProperty32 dpy state win
+ let stateset = S.fromList $ fromMaybe [] winstate
+
+ if fs then do
+ floats <- isFloating win
+ let float = if ff then True else floats
+ (_,loc) <- floatLocation win
+
+ let wmnew = if float then
+ M.union wm $ M.singleton win loc
+ else
+ wm
+ withDisplay $ \dpy -> io $ changeProperty32 dpy win state ptype propModeReplace $ S.toList $ S.insert (fromIntegral fullsc) stateset
+ fullscreenWin win
+ return $ Just $ FullscreenManager wmnew
+ else do
+ let float = if ff then True else M.member win wm
+ withDisplay $ \dpy -> io $ changeProperty32 dpy win state ptype propModeReplace $ S.toList $ S.delete (fromIntegral fullsc) stateset
+ if float then do
+ (_,defloc) <- floatLocation win
+ let loc = M.findWithDefault defloc win wm
+ floatWin win loc
+ else
+ tileWin win
+ return $ Just $ FullscreenManager $ M.delete win wm
+
+ handleMess _ _ = return Nothing
+
+ redoLayout (FullscreenManager wm) _ _ wrs = do
+ ws <- gets windowset
+ let wmnew = M.filterWithKey (\w _ -> M.member w $ W.floating ws) wm
+ return (wrs, Just $ FullscreenManager $ wmnew)
+
+
+
+isFloating :: Window -> X (Bool)
+isFloating w = gets windowset >>= \ws -> return $ M.member w (W.floating ws)
+
+
+doFullscreen :: ManageHook
+doFullscreen = Query $ do
+ w <- ask
+ lift $ setFullscreen w
+ return $ Endo id
+
+doFloatMaybeFullscreen :: ManageHook
+doFloatMaybeFullscreen = Query $ do
+ w <- ask
+ isFull <- lift $ runQuery isFullscreen w
+ lift $ if isFull then setFullscreenFloat w else unsetFullscreenFloat w
+ return $ Endo id
+
+
+setFullscreen, unsetFullscreen, setFullscreenFloat, unsetFullscreenFloat :: Window -> X ()
+setFullscreen w = sendMessage $ SetFullscreen w True False
+unsetFullscreen w = sendMessage $ SetFullscreen w False False
+setFullscreenFloat w = sendMessage $ SetFullscreen w True True
+unsetFullscreenFloat w = sendMessage $ SetFullscreen w False True
+
+fullscreenWin, tileWin :: Window -> X ()
+fullscreenWin w = windows $ W.float w $ W.RationalRect 0 0 1 1
+tileWin w = windows $ W.sink w
+
+floatWin :: Window -> W.RationalRect -> X ()
+floatWin w loc = windows $ W.float w loc
+
+
+handleFullscreen :: Event -> X All
+handleFullscreen (ClientMessageEvent _ _ _ _ win typ dat) = do
+ state <- getAtom "_NET_WM_STATE"
+ fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
+ isFull <- runQuery isFullscreen win
+
+ -- Constants for the _NET_WM_STATE protocol
+ let remove = 0
+ add = 1
+ toggle = 2
+ action = head dat
+
+ when (typ == state && (fromIntegral fullsc) `elem` tail dat) $ do
+ when (action == add || (action == toggle && not isFull)) $ setFullscreen win
+ when (head dat == remove || (action == toggle && isFull)) $ unsetFullscreen win
+
+ return $ All True
+
+handleFullscreen _ = return $ All True
diff --git a/lib/NoBorders.hs b/lib/NoBorders.hs
new file mode 100644
index 0000000..645464e
--- /dev/null
+++ b/lib/NoBorders.hs
@@ -0,0 +1,214 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+{-# LANGUAGE PatternGuards #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Layout.NoBorders
+-- Copyright : (c) David Roundy <droundy@darcs.net>
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- Make a given layout display without borders. This is useful for
+-- full-screen or tabbed layouts, where you don't really want to waste a
+-- couple of pixels of real estate just to inform yourself that the visible
+-- window has focus.
+--
+-----------------------------------------------------------------------------
+
+module NoBorders (
+ -- * Usage
+ -- $usage
+ noBorders,
+ smartBorders,
+ withBorder,
+ lessBorders,
+ SetsAmbiguous(..),
+ Ambiguity(..),
+ With(..)
+ ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import qualified XMonad.StackSet as W
+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:
+--
+-- > import XMonad.Layout.NoBorders
+--
+-- and modify the layouts to call noBorders on the layouts you want to lack
+-- borders:
+--
+-- > layoutHook = ... ||| noBorders Full ||| ...
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- todo, use an InvisibleList.
+data WithBorder a = WithBorder Dimension (M.Map a Dimension) deriving ( Read, Show )
+
+instance LayoutModifier WithBorder Window where
+ unhook (WithBorder _ s) = setBorders $ M.toList s
+
+ redoLayout (WithBorder n sold) _ _ wrs = do
+ s <- mapM (\w -> winBorderWidth w >>= \bw -> return (w,bw)) ws >>= return . M.fromList
+ let snew = M.mapWithKey (\w bw -> M.findWithDefault bw w sold) s
+
+ setBorders $ M.toList $ M.filterWithKey (\w _ -> elem w ws) sold
+ setBorders $ map (\w -> (w, n)) ws
+ return (wrs, Just $ WithBorder n $ snew)
+ where
+ ws = map fst wrs
+
+
+winBorderWidth :: Window -> X Dimension
+winBorderWidth w = withDisplay $ \d -> (fromIntegral . wa_border_width) `fmap` io (getWindowAttributes d w)
+
+-- | Removes all window borders from the specified layout.
+noBorders :: LayoutClass l Window => l Window -> ModifiedLayout WithBorder l Window
+noBorders = withBorder 0
+
+-- | Forces a layout to use the specified border width. 'noBorders' is
+-- equivalent to @'withBorder' 0@.
+withBorder :: LayoutClass l a => Dimension -> l a -> ModifiedLayout WithBorder l a
+withBorder b = ModifiedLayout $ WithBorder b M.empty
+
+setBorders :: [(Window, Dimension)] -> X ()
+setBorders ws = withDisplay $ \d -> mapM_ (\(w,bw) -> io $ setWindowBorderWidth d w bw) ws
+
+singleton :: [a] -> Bool
+singleton = null . drop 1
+
+type SmartBorder = ConfigurableBorder Ambiguity
+
+-- | Removes the borders from a window under one of the following conditions:
+--
+-- * There is only one screen and only one window. In this case it's obvious
+-- that it has the focus, so no border is needed.
+--
+-- * A floating window covers the entire screen (e.g. mplayer).
+--
+smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a
+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 M.empty)
+
+data ConfigurableBorder p w = ConfigurableBorder p (M.Map w Dimension) deriving (Read, Show)
+
+instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where
+ unhook (ConfigurableBorder _ s) = do
+ setBorders $ M.toList s
+
+ redoLayout (ConfigurableBorder p sold) _ mst wrs = do
+ wsh <- withWindowSet (\wset -> return (hiddens p wset mst wrs))
+ s <- mapM (\w -> winBorderWidth w >>= \bw -> return (w,bw)) ws >>= return . M.fromList
+ let snew = M.mapWithKey (\w bw -> M.findWithDefault bw w sold) s
+
+ setBorders $ M.toList $ M.filterWithKey (\w _ -> notElem w wsh) sold
+ setBorders $ map (\w -> (w, 0)) wsh
+ return (wrs, Just $ ConfigurableBorder p snew)
+ where
+ ws = map fst wrs
+
+-- | 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)