diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Xmobar/Config/Parse.hs | 11 | ||||
| -rw-r--r-- | src/Xmobar/X11/ColorCache.hs | 54 | ||||
| -rw-r--r-- | src/Xmobar/X11/Draw.hs | 10 | ||||
| -rw-r--r-- | src/Xmobar/X11/Loop.hs | 4 | ||||
| -rw-r--r-- | src/Xmobar/X11/Text.hs | 14 | ||||
| -rw-r--r-- | src/Xmobar/X11/XlibDraw.hs | 28 | 
6 files changed, 17 insertions, 104 deletions
| diff --git a/src/Xmobar/Config/Parse.hs b/src/Xmobar/Config/Parse.hs index 65e1af8..41088e9 100644 --- a/src/Xmobar/Config/Parse.hs +++ b/src/Xmobar/Config/Parse.hs @@ -26,16 +26,7 @@ import Data.Functor ((<&>))  import Xmobar.Config.Types -#ifdef XFT  import qualified System.IO as S (readFile) -#endif - -readFileSafe :: FilePath -> IO String -#ifdef XFT -readFileSafe = S.readFile -#else -readFileSafe = readFile -#endif  stripComments :: String -> String  stripComments = @@ -182,4 +173,4 @@ commandsErr = "commands: this usually means that a command could not" ++  -- parsed.  readConfig :: Config -> FilePath -> IO (Either ParseError (Config,[String]))  readConfig defaultConfig f = -  liftIO (readFileSafe f) <&> parseConfig defaultConfig +  liftIO (S.readFile f) <&> parseConfig defaultConfig diff --git a/src/Xmobar/X11/ColorCache.hs b/src/Xmobar/X11/ColorCache.hs index 4d22e16..b981775 100644 --- a/src/Xmobar/X11/ColorCache.hs +++ b/src/Xmobar/X11/ColorCache.hs @@ -2,7 +2,7 @@  ------------------------------------------------------------------------------  -- |  -- Module: ColorCache --- Copyright: (c) 2012 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2012, 2022 Jose Antonio Ortega Ruiz  -- License: BSD3-style (see LICENSE)  --  -- Maintainer: jao@gnu.org @@ -15,18 +15,8 @@  --  ------------------------------------------------------------------------------ -#if defined XFT - -module Xmobar.X11.ColorCache(withColors, withDrawingColors) where - -import Xmobar.X11.MinXft - -#else -  module Xmobar.X11.ColorCache(withColors) where -#endif -  import Data.IORef  import System.IO.Unsafe (unsafePerformIO)  import Control.Monad.Trans (MonadIO, liftIO) @@ -67,45 +57,3 @@ withColors :: MonadIO m => Display -> [String] -> ([Pixel] -> m a) -> m a  withColors d cs f = do    ps <- mapM (liftIO . initColor d) cs    f $ map (\(DynPixel _ pixel) -> pixel) ps - -#ifdef XFT - -type AXftColorCache = [(String, AXftColor)] -{-# NOINLINE xftColorCache #-} -xftColorCache :: IORef AXftColorCache -xftColorCache = unsafePerformIO $ newIORef [] - -getXftCachedColor :: String -> IO (Maybe AXftColor) -getXftCachedColor name = lookup name `fmap` readIORef xftColorCache - -putXftCachedColor :: String -> AXftColor -> IO () -putXftCachedColor name cptr = -  modifyIORef xftColorCache $ \c -> (name, cptr) : c - -initAXftColor' :: Display -> Visual -> Colormap -> String -> IO AXftColor -initAXftColor' d v cm c = do -  cc <- getXftCachedColor c -  c' <- case cc of -          Just col -> return col -          _        -> do c'' <- mallocAXftColor d v cm c -                         putXftCachedColor c c'' -                         return c'' -  return c' - -initAXftColor :: Display -> Visual -> Colormap -> String -> IO AXftColor -initAXftColor d v cm c = handle black $ (initAXftColor' d v cm c) -  where -    black :: SomeException -> IO AXftColor -    black = (const $ initAXftColor' d v cm "black") - -withDrawingColors :: -- MonadIO m => -                     Display -> Drawable -> String -> String -                    -> (AXftDraw -> AXftColor -> AXftColor -> IO ()) -> IO () -withDrawingColors dpy drw fc bc f = do -  let screen = defaultScreenOfDisplay dpy -      colormap = defaultColormapOfScreen screen -      visual = defaultVisualOfScreen screen -  fc' <- initAXftColor dpy visual colormap fc -  bc' <- initAXftColor dpy visual colormap bc -  withAXftDraw dpy drw visual colormap $ \draw -> f draw fc' bc' -#endif diff --git a/src/Xmobar/X11/Draw.hs b/src/Xmobar/X11/Draw.hs index 853ed03..5139aa9 100644 --- a/src/Xmobar/X11/Draw.hs +++ b/src/Xmobar/X11/Draw.hs @@ -27,12 +27,9 @@ import Graphics.X11.Xlib hiding (Segment)  import Xmobar.Run.Parsers (Segment)  import Xmobar.X11.Types -#if defined(XFT) || defined(CAIRO) +#ifdef CAIRO  import Xmobar.Config.Types  import Xmobar.X11.XRender (drawBackground) -#endif - -#ifdef CAIRO  import Xmobar.X11.CairoDraw  #else  import Xmobar.X11.XlibDraw @@ -50,14 +47,11 @@ drawInWin segments = do    gc <- liftIO $ createGC d w    liftIO $ setGraphicsExposures d gc False -#if defined(XFT) || defined(CAIRO) +#ifdef CAIRO    let cconf = config xconf        alph = alpha cconf    when (alph < 255)       (liftIO $ drawBackground d p (bgColor cconf) alph (Rectangle 0 0 wid ht)) -#endif - -#ifdef CAIRO    res <- drawInPixmap gc p segments  #else    res <- updateActions (rect xconf) segments diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs index 8b68944..e6feda0 100644 --- a/src/Xmobar/X11/Loop.hs +++ b/src/Xmobar/X11/Loop.hs @@ -60,7 +60,7 @@ import Xmobar.Run.Loop (loop)  import Xmobar.X11.Events(nextEvent')  #endif -#ifdef XFT +#ifdef CAIRO  import Graphics.X11.Xft  #endif @@ -77,7 +77,7 @@ x11Loop conf = do    let ic = Map.empty        to = textOffset conf        ts = textOffsets conf ++ replicate (length fl) to -#ifdef XFT +#ifdef CAIRO    xftInitFtLibrary  #endif    (r,w) <- createWin d fs conf diff --git a/src/Xmobar/X11/Text.hs b/src/Xmobar/X11/Text.hs index 36a2a12..f3c5e05 100644 --- a/src/Xmobar/X11/Text.hs +++ b/src/Xmobar/X11/Text.hs @@ -3,7 +3,7 @@  -----------------------------------------------------------------------------  -- |  -- Module      :  Xmobar.X11.Text --- Copyright   :  (C) 2011, 2012, 2013, 2014, 2015, 2017, 2018 Jose Antonio Ortega Ruiz +-- Copyright   :  (C) 2011, 2012, 2013, 2014, 2015, 2017, 2018, 2022 Jose Antonio Ortega Ruiz  --                (C) 2007 Andrea Rossato  -- License     :  BSD3  -- @@ -30,7 +30,7 @@ import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth)  import Graphics.X11.Xlib.Extras  import System.Mem.Weak ( addFinalizer ) -#if defined XFT +#ifdef CAIRO  import Xmobar.X11.MinXft  import Graphics.X11.Xrender  #else @@ -39,7 +39,7 @@ import System.IO(hPutStrLn, stderr)  data XFont = Core FontStruct             | Utf8 FontSet -#ifdef XFT +#ifdef CAIRO             | Xft  [AXftFont]  #endif @@ -49,7 +49,7 @@ initFont :: Display -> String -> IO XFont  initFont d s =         let xftPrefix = "xft:" in         if  xftPrefix `isPrefixOf` s then -#ifdef XFT +#ifdef CAIRO             fmap Xft $ initXftFont d s  #else             do @@ -86,7 +86,7 @@ initUtf8Font d s = do              fallBack :: SomeException -> IO ([String], String, FontSet)              fallBack = const $ createFontSet d miscFixedFont -#ifdef XFT +#ifdef CAIRO  initXftFont :: Display -> String -> IO [AXftFont]  initXftFont d s = do    let fontNames = wordsBy (== ',') (drop 4 s) @@ -106,7 +106,7 @@ initXftFont d s = do  textWidth :: Display -> XFont -> String -> IO Int  textWidth _   (Utf8 fs) s = return $ fromIntegral $ wcTextEscapement fs s  textWidth _   (Core fs) s = return $ fromIntegral $ Xlib.textWidth fs s -#ifdef XFT +#ifdef CAIRO  textWidth dpy (Xft xftdraw) s = do      gi <- xftTxtExtents' dpy xftdraw s      return $ xglyphinfo_xOff gi @@ -121,7 +121,7 @@ textExtents (Utf8 fs) s = do        ascent  = fromIntegral $ negate (rect_y rl)        descent = fromIntegral $ rect_height rl + fromIntegral (rect_y rl)    return (ascent, descent) -#ifdef XFT +#ifdef CAIRO  textExtents (Xft xftfonts) _ = do    ascent  <- fromIntegral `fmap` xft_ascent'  xftfonts    descent <- fromIntegral `fmap` xft_descent' xftfonts diff --git a/src/Xmobar/X11/XlibDraw.hs b/src/Xmobar/X11/XlibDraw.hs index 15a0ec7..5aec1eb 100644 --- a/src/Xmobar/X11/XlibDraw.hs +++ b/src/Xmobar/X11/XlibDraw.hs @@ -40,15 +40,10 @@ import Xmobar.X11.Text  import Xmobar.X11.ColorCache  import Xmobar.System.Utils (safeIndex) -#ifdef XFT -import Xmobar.X11.MinXft -import Graphics.X11.Xrender -#endif -  fi :: (Integral a, Num b) => a -> b  fi = fromIntegral -drawInPixmap :: GC -> Pixmap -> Dimension -> Dimension -> [[Segment]] -> X() +drawInPixmap :: GC -> Pixmap -> Dimension -> Dimension -> [[Segment]] -> X ()  drawInPixmap gc p wid ht ~[left,center,right] = do    r <- ask    let c = config r @@ -61,14 +56,11 @@ drawInPixmap gc p wid ht ~[left,center,right] = do          textWidth d (safeIndex fs i) s >>= \tw -> return (Text s,cl,i,fi tw)        getWidth (Icon s,cl,i,_) = return (Icon s,cl,i,fi $ iconW s)        getWidth (Hspace s,cl,i,_) = return (Hspace s,cl,i,fi s) -      fillBackground clr = setForeground d gc clr >> fillRectangle d p gc 0 0 wid ht    withColors d [bgColor c, borderColor c] $ \[bgcolor, bdcolor] -> do -#if XFT -    when (alpha c == 255) $ liftIO (fillBackground bgcolor) -#else -    liftIO $ fillBackground bgcolor -#endif +    liftIO $ setForeground d gc bgcolor +    liftIO $ fillRectangle d p gc 0 0 wid ht +      -- write to the pixmap the new string      printStrings p gc fs vs 1 L [] =<< strLn left      printStrings p gc fs vs 1 R [] =<< strLn right @@ -115,18 +107,6 @@ printString d p (Utf8 fs) gc fc bc x y _ _ s a =        when (a == 255) (setBackground d gc bc')        liftIO $ wcDrawImageString d p fs gc x y s -#ifdef XFT -printString dpy drw fs@(Xft fonts) _ fc bc x y ay ht s al = -  withDrawingColors dpy drw fc bc $ \draw fc' bc' -> do -    when (al == 255) $ do -      (a,d)  <- textExtents fs s -      gi <- xftTxtExtents' dpy fonts s -      if ay < 0 -        then drawXftRect draw bc' x (y - a) (1 + xglyphinfo_xOff gi) (a + d + 2) -        else drawXftRect draw bc' x ay (1 + xglyphinfo_xOff gi) ht -    drawXftString' draw fc' fonts (toInteger x) (toInteger y) s -#endif -  -- | An easy way to print the stuff we need to print  printStrings :: Drawable               -> GC | 
