xmobar-0.45: src/Xmobar/X11/Window.hs
-----------------------------------------------------------------------------
-- |
-- Module : Window
-- Copyright : (c) 2011-18, 2020-22 Jose A. Ortega Ruiz
-- : (c) 2012 Jochen Keil
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability : unstable
-- Portability : unportable
--
-- Window manipulation functions
--
-----------------------------------------------------------------------------
module Xmobar.X11.Window where
import qualified Control.Monad as CM
import qualified Data.Function as DF
import qualified Data.List as DL
import qualified Data.Maybe as DM
import qualified Graphics.X11.Xlib as X
import qualified Graphics.X11.Xlib.Extras as Xx
import qualified Graphics.X11.Xinerama as Xi
import qualified Foreign.C.Types as C
import qualified System.Posix.Process as PP
import qualified Xmobar.Config.Types as T
import qualified Xmobar.X11.Text as Txt
-- $window
-- | Creates a window with the attribute override_redirect set to True.
-- Windows Managers should not touch this kind of windows.
newWindow ::
X.Display -> X.Screen -> X.Window -> X.Rectangle -> Bool -> IO X.Window
newWindow dpy scr rw (X.Rectangle x y w h) o = do
let visual = X.defaultVisualOfScreen scr
attrmask = if o then X.cWOverrideRedirect else 0
X.allocaSetWindowAttributes $
\attributes -> do
X.set_override_redirect attributes o
X.createWindow dpy rw x y w h 0 (X.defaultDepthOfScreen scr)
X.inputOutput visual attrmask attributes
-- | The function to create the initial window
createWin :: X.Display -> Txt.XFont -> T.Config -> IO (X.Rectangle, X.Window)
createWin d fs c = do
let dflt = X.defaultScreen d
srs <- Xi.getScreenInfo d
rootw <- X.rootWindow d dflt
(as,ds) <- Txt.textExtents fs "0"
let ht = as + ds + 4
r = setPosition c (T.position c) srs (fromIntegral ht)
win <- newWindow d (X.defaultScreenOfDisplay d) rootw r (T.overrideRedirect c)
setProperties c d win
setStruts r c d win srs
CM.when (T.lowerOnStart c) $ X.lowerWindow d win
CM.unless (T.hideOnStart c) $ showWindow r c d win
return (r,win)
-- | Updates the size and position of the window
repositionWin :: X.Display -> X.Window -> Txt.XFont -> T.Config -> IO X.Rectangle
repositionWin d win fs c = do
srs <- Xi.getScreenInfo d
(as,ds) <- Txt.textExtents fs "0"
let ht = as + ds + 4
r = setPosition c (T.position c) srs (fromIntegral ht)
X.moveResizeWindow d win
(X.rect_x r) (X.rect_y r) (X.rect_width r) (X.rect_height r)
setStruts r c d win srs
X.sync d False
return r
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
setPosition ::
T.Config -> T.XPosition -> [X.Rectangle] -> X.Dimension -> X.Rectangle
setPosition c p rs ht =
case p' of
T.Top -> X.Rectangle rx ry rw h
T.TopP l r -> X.Rectangle (rx + fi l) ry (rw - fi l - fi r) h
T.TopH ch -> X.Rectangle rx ry rw (mh ch)
T.TopW a i -> X.Rectangle (ax a i) ry (nw i) h
T.TopSize a i ch -> X.Rectangle (ax a i) ry (nw i) (mh ch)
T.Bottom -> X.Rectangle rx ny rw h
T.BottomH ch -> X.Rectangle rx (ny' ch) rw (mh ch)
T.BottomW a i -> X.Rectangle (ax a i) ny (nw i) h
T.BottomP l r -> X.Rectangle (rx + fi l) ny (rw - fi l - fi r) h
T.BottomSize a i ch -> X.Rectangle (ax a i) (ny' ch) (nw i) (mh ch)
T.Static cx cy cw ch -> X.Rectangle (fi cx) (fi cy) (fi cw) (fi ch)
T.OnScreen _ p'' -> setPosition c p'' [scr] ht
where
(scr@(X.Rectangle rx ry rw rh), p') =
case p of T.OnScreen i x -> (DM.fromMaybe (picker rs) $ safeIndex i rs, x)
_ -> (picker rs, p)
ny = ry + fi (rh - ht)
center i = rx + fi (div (remwid i) 2)
right i = rx + fi (remwid i)
remwid i = rw - pw (fi i)
ax T.L = const rx
ax T.R = right
ax T.C = center
pw i = rw * min 100 i `div` 100
nw = fi . pw . fi
h = fi ht
mh h' = max (fi h') h
ny' h' = ry + fi (rh - mh h')
safeIndex i = lookup i . zip [0..]
picker = if T.pickBroadest c
then DL.maximumBy (compare `DF.on` X.rect_width)
else head
setProperties :: T.Config -> X.Display -> X.Window -> IO ()
setProperties c d w = do
let mkatom n = X.internAtom d n False
card <- mkatom "CARDINAL"
atom <- mkatom "ATOM"
X.setTextProperty d w (T.wmClass c) X.wM_CLASS
X.setTextProperty d w (T.wmName c) X.wM_NAME
wtype <- mkatom "_NET_WM_WINDOW_TYPE"
dock <- mkatom "_NET_WM_WINDOW_TYPE_DOCK"
Xx.changeProperty32 d w wtype atom Xx.propModeReplace [fi dock]
CM.when (T.allDesktops c) $ do
desktop <- mkatom "_NET_WM_DESKTOP"
Xx.changeProperty32 d w desktop card Xx.propModeReplace [0xffffffff]
pid <- mkatom "_NET_WM_PID"
PP.getProcessID >>=
Xx.changeProperty32 d w pid card Xx.propModeReplace . return . fi
setStruts' :: X.Display -> X.Window -> [C.CLong] -> IO ()
setStruts' d w svs = do
let mkatom n = X.internAtom d n False
card <- mkatom "CARDINAL"
pstrut <- mkatom "_NET_WM_STRUT_PARTIAL"
strut <- mkatom "_NET_WM_STRUT"
Xx.changeProperty32 d w pstrut card Xx.propModeReplace svs
Xx.changeProperty32 d w strut card Xx.propModeReplace (take 4 svs)
setStruts ::
X.Rectangle -> T.Config -> X.Display -> X.Window -> [X.Rectangle] -> IO ()
setStruts r c d w rs = do
let svs = map fi $ getStrutValues r (T.position c) (getRootWindowHeight rs)
setStruts' d w svs
getRootWindowHeight :: [X.Rectangle] -> Int
getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs)
where
getMaxScreenYCoord sr = fi (X.rect_y sr) + fi (X.rect_height sr)
getStrutValues :: X.Rectangle -> T.XPosition -> Int -> [Int]
getStrutValues r@(X.Rectangle x y w h) p rwh =
case p of
T.OnScreen _ p' -> getStrutValues r p' rwh
T.Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
T.TopH _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
T.TopP _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
T.TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
T.TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
T.Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
T.BottomH _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
T.BottomP _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
T.BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
T.BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
T.Static {} -> getStaticStrutValues p rwh
where st = fi y + fi h
sb = rwh - fi y
nx = fi x
nw = fi (x + fi w - 1)
-- get some reaonable strut values for static placement.
getStaticStrutValues :: T.XPosition -> Int -> [Int]
getStaticStrutValues (T.Static cx cy cw ch) rwh
-- if the yPos is in the top half of the screen, then assume a Top
-- placement, otherwise, it's a Bottom placement
| cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0]
| otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe]
where st = cy + ch
sb = rwh - cy
xs = cx -- a simple calculation for horizontal (x) placement
xe = xs + cw - 1
getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
hideWindow :: X.Display -> X.Window -> IO ()
hideWindow d w = do
setStruts' d w (replicate 12 0)
Xx.unmapWindow d w >> X.sync d False
showWindow :: X.Rectangle -> T.Config -> X.Display -> X.Window -> IO ()
showWindow r c d w = do
X.mapWindow d w
Xi.getScreenInfo d >>= setStruts r c d w
X.sync d False
isMapped :: X.Display -> X.Window -> IO Bool
isMapped d w = ism <$> Xx.getWindowAttributes d w
where ism Xx.WindowAttributes { Xx.wa_map_state = wms } = wms /= Xx.waIsUnmapped