summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar')
-rw-r--r--src/Xmobar/Plugins/Monitors/Common/Types.hs2
-rw-r--r--src/Xmobar/X11/ColorCache.hs48
-rw-r--r--src/Xmobar/X11/Text.hs38
-rw-r--r--src/Xmobar/X11/Window.hs201
4 files changed, 149 insertions, 140 deletions
diff --git a/src/Xmobar/Plugins/Monitors/Common/Types.hs b/src/Xmobar/Plugins/Monitors/Common/Types.hs
index d09da8e..68d7a0e 100644
--- a/src/Xmobar/Plugins/Monitors/Common/Types.hs
+++ b/src/Xmobar/Plugins/Monitors/Common/Types.hs
@@ -116,7 +116,7 @@ getMonitorConfig MC{..} = do
pBarBack <- readIORef barBack
pBarFore <- readIORef barFore
pBarWidth <- readIORef barWidth
- pUseSuffix <- readIORef useSuffix
+ pUseSuffix <- readIORef useSuffix
pNaString <- readIORef naString
pMaxTotalWidth <- readIORef maxTotalWidth
pMaxTotalWidthEllipsis <- readIORef maxTotalWidthEllipsis
diff --git a/src/Xmobar/X11/ColorCache.hs b/src/Xmobar/X11/ColorCache.hs
index b981775..a8a07cd 100644
--- a/src/Xmobar/X11/ColorCache.hs
+++ b/src/Xmobar/X11/ColorCache.hs
@@ -17,43 +17,45 @@
module Xmobar.X11.ColorCache(withColors) where
-import Data.IORef
-import System.IO.Unsafe (unsafePerformIO)
-import Control.Monad.Trans (MonadIO, liftIO)
-import Control.Exception (SomeException, handle)
-import Graphics.X11.Xlib
+import qualified Data.IORef as IO
+import qualified System.IO.Unsafe as U
-data DynPixel = DynPixel Bool Pixel
+import qualified Control.Exception as E
+import qualified Control.Monad.Trans as Tr
-initColor :: Display -> String -> IO DynPixel
-initColor dpy c = handle black $ initColor' dpy c
+import qualified Graphics.X11.Xlib as X
+
+data DynPixel = DynPixel Bool X.Pixel
+
+initColor :: X.Display -> String -> IO DynPixel
+initColor dpy c = E.handle black $ initColor' dpy c
where
- black :: SomeException -> IO DynPixel
- black = const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy)
+ black :: E.SomeException -> IO DynPixel
+ black = const . return $ DynPixel False (X.blackPixel dpy $ X.defaultScreen dpy)
-type ColorCache = [(String, Color)]
+type ColorCache = [(String, X.Color)]
{-# NOINLINE colorCache #-}
-colorCache :: IORef ColorCache
-colorCache = unsafePerformIO $ newIORef []
+colorCache :: IO.IORef ColorCache
+colorCache = U.unsafePerformIO $ IO.newIORef []
-getCachedColor :: String -> IO (Maybe Color)
-getCachedColor color_name = lookup color_name `fmap` readIORef colorCache
+getCachedColor :: String -> IO (Maybe X.Color)
+getCachedColor color_name = lookup color_name `fmap` IO.readIORef colorCache
-putCachedColor :: String -> Color -> IO ()
-putCachedColor name c_id = modifyIORef colorCache $ \c -> (name, c_id) : c
+putCachedColor :: String -> X.Color -> IO ()
+putCachedColor name c_id = IO.modifyIORef colorCache $ \c -> (name, c_id) : c
-initColor' :: Display -> String -> IO DynPixel
+initColor' :: X.Display -> String -> IO DynPixel
initColor' dpy c = do
- let colormap = defaultColormap dpy (defaultScreen dpy)
+ let colormap = X.defaultColormap dpy (X.defaultScreen dpy)
cached_color <- getCachedColor c
c' <- case cached_color of
Just col -> return col
- _ -> do (c'', _) <- allocNamedColor dpy colormap c
+ _ -> do (c'', _) <- X.allocNamedColor dpy colormap c
putCachedColor c c''
return c''
- return $ DynPixel True (color_pixel c')
+ return $ DynPixel True (X.color_pixel c')
-withColors :: MonadIO m => Display -> [String] -> ([Pixel] -> m a) -> m a
+withColors :: Tr.MonadIO m => X.Display -> [String] -> ([X.Pixel] -> m a) -> m a
withColors d cs f = do
- ps <- mapM (liftIO . initColor d) cs
+ ps <- mapM (Tr.liftIO . initColor d) cs
f $ map (\(DynPixel _ pixel) -> pixel) ps
diff --git a/src/Xmobar/X11/Text.hs b/src/Xmobar/X11/Text.hs
index 6da96fa..357ee3c 100644
--- a/src/Xmobar/X11/Text.hs
+++ b/src/Xmobar/X11/Text.hs
@@ -20,16 +20,16 @@ module Xmobar.X11.Text
, textWidth
) where
-import Control.Exception (SomeException, handle)
+import qualified Control.Exception as E
+import qualified Foreign as F
+import qualified System.Mem.Weak as W
-import Foreign
-import Graphics.X11.Xlib hiding (textExtents, textWidth)
-import Graphics.X11.Xlib.Extras
-import System.Mem.Weak ( addFinalizer )
+import qualified Graphics.X11.Xlib as X
+import qualified Graphics.X11.Xlib.Extras as Xx
-type XFont = FontSet
+type XFont = Xx.FontSet
-initFont :: Display -> String -> IO XFont
+initFont :: X.Display -> String -> IO XFont
initFont = initUtf8Font
miscFixedFont :: String
@@ -37,21 +37,21 @@ miscFixedFont = "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*"
-- | Given a fontname returns the font structure. If the font name is
-- not valid the default font will be loaded and returned.
-initUtf8Font :: Display -> String -> IO FontSet
+initUtf8Font :: X.Display -> String -> IO Xx.FontSet
initUtf8Font d s = do
- (_,_,f) <- handle fallBack getIt
- addFinalizer f (freeFontSet d f)
+ (_,_,f) <- E.handle fallBack getIt
+ W.addFinalizer f (Xx.freeFontSet d f)
return f
- where getIt = createFontSet d s
- fallBack :: SomeException -> IO ([String], String, FontSet)
- fallBack = const $ createFontSet d miscFixedFont
+ where getIt = Xx.createFontSet d s
+ fallBack :: E.SomeException -> IO ([String], String, Xx.FontSet)
+ fallBack = const $ Xx.createFontSet d miscFixedFont
-textWidth :: Display -> XFont -> String -> IO Int
-textWidth _ fs s = return $ fromIntegral $ wcTextEscapement fs s
+textWidth :: X.Display -> XFont -> String -> IO Int
+textWidth _ fs s = return $ fromIntegral $ Xx.wcTextEscapement fs s
-textExtents :: XFont -> String -> IO (Int32,Int32)
+textExtents :: XFont -> String -> IO (F.Int32, F.Int32)
textExtents fs s = do
- let (_,rl) = wcTextExtents fs s
- ascent = fromIntegral $ negate (rect_y rl)
- descent = fromIntegral $ rect_height rl + fromIntegral (rect_y rl)
+ let (_,rl) = Xx.wcTextExtents fs s
+ ascent = fromIntegral $ negate (X.rect_y rl)
+ descent = fromIntegral $ X.rect_height rl + fromIntegral (X.rect_y rl)
return (ascent, descent)
diff --git a/src/Xmobar/X11/Window.hs b/src/Xmobar/X11/Window.hs
index d42d74a..ad7ebf7 100644
--- a/src/Xmobar/X11/Window.hs
+++ b/src/Xmobar/X11/Window.hs
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : Window
--- Copyright : (c) 2011-18, 20, 21 Jose A. Ortega Ruiz
+-- Copyright : (c) 2011-18, 2020-22 Jose A. Ortega Ruiz
-- : (c) 2012 Jochen Keil
-- License : BSD-style (see LICENSE)
--
@@ -15,164 +15,171 @@
module Xmobar.X11.Window where
-import Prelude
-import Control.Monad (when, unless)
-import Graphics.X11.Xlib hiding (textExtents)
-import Graphics.X11.Xlib.Extras
-import Graphics.X11.Xinerama
-import Foreign.C.Types (CLong)
+import qualified Control.Monad as CM
-import Data.Function (on)
-import Data.List (maximumBy)
-import Data.Maybe (fromMaybe)
-import System.Posix.Process (getProcessID)
+import qualified Data.Function as DF
+import qualified Data.List as DL
+import qualified Data.Maybe as DM
-import Xmobar.Config.Types
-import Xmobar.X11.Text
+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 :: Display -> Screen -> Window -> Rectangle -> Bool -> IO Window
-newWindow dpy scr rw (Rectangle x y w h) o = do
- let visual = defaultVisualOfScreen scr
- attrmask = if o then cWOverrideRedirect else 0
- allocaSetWindowAttributes $
+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
- set_override_redirect attributes o
- createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr)
- inputOutput visual attrmask attributes
+ 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 :: Display -> XFont -> Config -> IO (Rectangle,Window)
+createWin :: X.Display -> Txt.XFont -> T.Config -> IO (X.Rectangle, X.Window)
createWin d fs c = do
- let dflt = defaultScreen d
- srs <- getScreenInfo d
- rootw <- rootWindow d dflt
- (as,ds) <- textExtents fs "0"
+ 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 (position c) srs (fromIntegral ht)
- win <- newWindow d (defaultScreenOfDisplay d) rootw r (overrideRedirect c)
+ 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
- when (lowerOnStart c) $ lowerWindow d win
- unless (hideOnStart c) $ showWindow r c d win
+ 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 :: Display -> Window -> XFont -> Config -> IO Rectangle
+repositionWin :: X.Display -> X.Window -> Txt.XFont -> T.Config -> IO X.Rectangle
repositionWin d win fs c = do
- srs <- getScreenInfo d
- (as,ds) <- textExtents fs "0"
+ srs <- Xi.getScreenInfo d
+ (as,ds) <- Txt.textExtents fs "0"
let ht = as + ds + 4
- r = setPosition c (position c) srs (fromIntegral ht)
- moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r)
+ 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
- sync d False
+ X.sync d False
return r
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
-setPosition :: Config -> XPosition -> [Rectangle] -> Dimension -> Rectangle
+setPosition ::
+ T.Config -> T.XPosition -> [X.Rectangle] -> X.Dimension -> X.Rectangle
setPosition c p rs ht =
case p' of
- Top -> Rectangle rx ry rw h
- TopP l r -> Rectangle (rx + fi l) ry (rw - fi l - fi r) h
- TopH ch -> Rectangle rx ry rw (mh ch)
- TopW a i -> Rectangle (ax a i) ry (nw i) h
- TopSize a i ch -> Rectangle (ax a i) ry (nw i) (mh ch)
- Bottom -> Rectangle rx ny rw h
- BottomH ch -> Rectangle rx (ny' ch) rw (mh ch)
- BottomW a i -> Rectangle (ax a i) ny (nw i) h
- BottomP l r -> Rectangle (rx + fi l) ny (rw - fi l - fi r) h
- BottomSize a i ch -> Rectangle (ax a i) (ny' ch) (nw i) (mh ch)
- Static cx cy cw ch -> Rectangle (fi cx) (fi cy) (fi cw) (fi ch)
- OnScreen _ p'' -> setPosition c p'' [scr] ht
+ 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@(Rectangle rx ry rw rh), p') =
- case p of OnScreen i x -> (fromMaybe (picker rs) $ safeIndex i rs, x)
+ (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 L = const rx
- ax R = right
- ax C = center
+ 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 pickBroadest c
- then maximumBy (compare `on` rect_width)
+ picker = if T.pickBroadest c
+ then DL.maximumBy (compare `DF.on` X.rect_width)
else head
-setProperties :: Config -> Display -> Window -> IO ()
+setProperties :: T.Config -> X.Display -> X.Window -> IO ()
setProperties c d w = do
- let mkatom n = internAtom d n False
+ let mkatom n = X.internAtom d n False
card <- mkatom "CARDINAL"
atom <- mkatom "ATOM"
- setTextProperty d w (wmClass c) wM_CLASS
- setTextProperty d w (wmName c) wM_NAME
+ 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"
- changeProperty32 d w wtype atom propModeReplace [fi dock]
+ Xx.changeProperty32 d w wtype atom Xx.propModeReplace [fi dock]
- when (allDesktops c) $ do
+ CM.when (T.allDesktops c) $ do
desktop <- mkatom "_NET_WM_DESKTOP"
- changeProperty32 d w desktop card propModeReplace [0xffffffff]
+ Xx.changeProperty32 d w desktop card Xx.propModeReplace [0xffffffff]
pid <- mkatom "_NET_WM_PID"
- getProcessID >>= changeProperty32 d w pid card propModeReplace . return . fi
+ PP.getProcessID >>=
+ Xx.changeProperty32 d w pid card Xx.propModeReplace . return . fi
-setStruts' :: Display -> Window -> [Foreign.C.Types.CLong] -> IO ()
+setStruts' :: X.Display -> X.Window -> [C.CLong] -> IO ()
setStruts' d w svs = do
- let mkatom n = internAtom d n False
+ let mkatom n = X.internAtom d n False
card <- mkatom "CARDINAL"
pstrut <- mkatom "_NET_WM_STRUT_PARTIAL"
strut <- mkatom "_NET_WM_STRUT"
- changeProperty32 d w pstrut card propModeReplace svs
- changeProperty32 d w strut card propModeReplace (take 4 svs)
+ Xx.changeProperty32 d w pstrut card Xx.propModeReplace svs
+ Xx.changeProperty32 d w strut card Xx.propModeReplace (take 4 svs)
-setStruts :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
+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 (position c) (getRootWindowHeight rs)
+ let svs = map fi $ getStrutValues r (T.position c) (getRootWindowHeight rs)
setStruts' d w svs
-getRootWindowHeight :: [Rectangle] -> Int
+getRootWindowHeight :: [X.Rectangle] -> Int
getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs)
where
- getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr)
+ getMaxScreenYCoord sr = fi (X.rect_y sr) + fi (X.rect_height sr)
-getStrutValues :: Rectangle -> XPosition -> Int -> [Int]
-getStrutValues r@(Rectangle x y w h) p rwh =
+getStrutValues :: X.Rectangle -> T.XPosition -> Int -> [Int]
+getStrutValues r@(X.Rectangle x y w h) p rwh =
case p of
- OnScreen _ p' -> getStrutValues r p' rwh
- Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
- TopH _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
- TopP _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
- TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
- TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
- Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
- BottomH _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
- BottomP _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
- BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
- BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
- Static {} -> getStaticStrutValues p rwh
+ 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 :: XPosition -> Int -> [Int]
-getStaticStrutValues (Static cx cy cw ch) rwh
+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]
@@ -183,17 +190,17 @@ getStaticStrutValues (Static cx cy cw ch) rwh
xe = xs + cw - 1
getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
-hideWindow :: Display -> Window -> IO ()
+hideWindow :: X.Display -> X.Window -> IO ()
hideWindow d w = do
setStruts' d w (replicate 12 0)
- unmapWindow d w >> sync d False
+ Xx.unmapWindow d w >> X.sync d False
-showWindow :: Rectangle -> Config -> Display -> Window -> IO ()
+showWindow :: X.Rectangle -> T.Config -> X.Display -> X.Window -> IO ()
showWindow r c d w = do
- mapWindow d w
- getScreenInfo d >>= setStruts r c d w
- sync d False
+ X.mapWindow d w
+ Xi.getScreenInfo d >>= setStruts r c d w
+ X.sync d False
-isMapped :: Display -> Window -> IO Bool
-isMapped d w = ism <$> getWindowAttributes d w
- where ism WindowAttributes { wa_map_state = wms } = wms /= waIsUnmapped
+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
generated by cgit v1.2.3 (git 2.46.0) at 2025-10-31 08:07:28 +0000