diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/ConfigurableBorders.hs | 84 | ||||
| -rw-r--r-- | lib/FullscreenManager.hs | 138 | ||||
| -rw-r--r-- | lib/NoBorders.hs | 214 |
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) |