From 42b392e06a7665e321682b9edeed5ce1ef172e6f Mon Sep 17 00:00:00 2001 From: Ilya Date: Thu, 12 Aug 2021 19:28:23 +0300 Subject: [PATCH] X.U.Font: Add font-fallback support This adds basic font-fallback support for X.U.Font, as well as modules using it, like X.Prompt and X.A.TreeSelect. In the new system, multiple fonts may be specified with the syntax "xft:iosevka-11,FontAwesome-9" Fixes: https://github.com/xmonad/xmonad-contrib/issues/208 --- CHANGES.md | 14 ++++++++ XMonad/Actions/TreeSelect.hs | 11 ++++-- XMonad/Util/Font.hs | 65 +++++++++++++++++++++++++----------- 3 files changed, 67 insertions(+), 23 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index b2e77a82..bf66815a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -28,6 +28,12 @@ - Added `transposeChars` to interchange the characters around the point and bound it to `C-t` in the Emacs XPKeymaps. + - Added xft-based font fallback support. This may be used by + appending other fonts to the given string: + `xft:iosevka-11,FontAwesome-9`. Note that this requires + `xmonad-contrib` to be compiled with `X11-xft` version 0.3.4 or + higher. + * `XMonad.Hooks.WindowSwallowing` - Fixed windows getting lost when used in conjunction with @@ -53,6 +59,14 @@ passed onto the modified layout, even when focus leaves the workspace using the modified layout. + * `XMonad.Actions.TreeSelect` + + - Added xft-based font fallback support. This may be used by + appending other fonts to the given string: + `xft:iosevka-11,FontAwesome-9`. Note that this requires + `xmonad-contrib` to be compiled with `X11-xft` version 0.3.4 or + higher. + ## 0.17.0 (October 27, 2021) ### Breaking Changes diff --git a/XMonad/Actions/TreeSelect.hs b/XMonad/Actions/TreeSelect.hs index 2ed17f19..110930a7 100644 --- a/XMonad/Actions/TreeSelect.hs +++ b/XMonad/Actions/TreeSelect.hs @@ -79,8 +79,9 @@ import XMonad.Hooks.WorkspaceHistory import qualified Data.Map as M #ifdef XFT -import Graphics.X11.Xft +import qualified Data.List.NonEmpty as NE import Graphics.X11.Xrender +import Graphics.X11.Xft #endif -- $usage @@ -648,10 +649,14 @@ drawStringXMF display window visual colormap gc font col x y text = case font of setForeground display gc col wcDrawImageString display window fnt gc x y text #ifdef XFT - Xft fnt -> do + Xft fnts -> do withXftDraw display window visual colormap $ \ft_draw -> withXftColorValue display visual colormap (fromARGB col) $ - \ft_color -> xftDrawString ft_draw ft_color fnt x y text +#if MIN_VERSION_X11_xft(0, 3, 4) + \ft_color -> xftDrawStringFallback ft_draw ft_color (NE.toList fnts) (fi x) (fi y) text +#else + \ft_color -> xftDrawString ft_draw ft_color (NE.head fnts) x y text +#endif -- | Convert 'Pixel' to 'XRenderColor' -- diff --git a/XMonad/Util/Font.hs b/XMonad/Util/Font.hs index 8e483244..a97c0490 100644 --- a/XMonad/Util/Font.hs +++ b/XMonad/Util/Font.hs @@ -41,15 +41,16 @@ import Control.Exception as E import Text.Printf (printf) #ifdef XFT -import Graphics.X11.Xft +import qualified Data.List.NonEmpty as NE import Graphics.X11.Xrender +import Graphics.X11.Xft #endif -- Hide the Core Font/Xft switching here data XMonadFont = Core FontStruct | Utf8 FontSet #ifdef XFT - | Xft XftFont + | Xft (NE.NonEmpty XftFont) #endif -- $usage @@ -109,34 +110,44 @@ releaseUtf8Font fs = do -- Example: 'xft: Sans-10' initXMF :: String -> X XMonadFont initXMF s = -#ifdef XFT +#ifndef XFT + Utf8 <$> initUtf8Font s +#else if xftPrefix `isPrefixOf` s then do dpy <- asks display - xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s) - return (Xft xftdraw) - else -#endif - Utf8 <$> initUtf8Font s -#ifdef XFT - where xftPrefix = "xft:" + let fonts = case wordsBy (== ',') (drop (length xftPrefix) s) of + [] -> "xft:monospace" :| [] -- NE.singleton only in base 4.15 + (x : xs) -> x :| xs + Xft <$> io (traverse (openFont dpy) fonts) + else Utf8 <$> initUtf8Font s + where + xftPrefix = "xft:" + openFont dpy str = xftFontOpen dpy (defaultScreenOfDisplay dpy) str + wordsBy p str = case dropWhile p str of + "" -> [] + str' -> w : wordsBy p str'' + where (w, str'') = break p str' #endif releaseXMF :: XMonadFont -> X () #ifdef XFT -releaseXMF (Xft xftfont) = do +releaseXMF (Xft xftfonts) = do dpy <- asks display - io $ xftFontClose dpy xftfont + io $ mapM_ (xftFontClose dpy) xftfonts #endif releaseXMF (Utf8 fs) = releaseUtf8Font fs releaseXMF (Core fs) = releaseCoreFont fs - textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int textWidthXMF _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s #ifdef XFT textWidthXMF dpy (Xft xftdraw) s = liftIO $ do - gi <- xftTextExtents dpy xftdraw s +#if MIN_VERSION_X11_xft(0, 3, 4) + gi <- xftTextAccumExtents dpy (toList xftdraw) s +#else + gi <- xftTextExtents dpy (NE.head xftdraw) s +#endif return $ xglyphinfo_xOff gi #endif @@ -150,9 +161,15 @@ textExtentsXMF (Core fs) s = do let (_,a,d,_) = textExtents fs s return (a,d) #ifdef XFT -textExtentsXMF (Xft xftfont) _ = io $ do - ascent <- fi <$> xftfont_ascent xftfont - descent <- fi <$> xftfont_descent xftfont +#if MIN_VERSION_X11_xft(0, 3, 4) +textExtentsXMF (Xft xftfonts) _ = io $ do + ascent <- fi <$> xftfont_max_ascent xftfonts + descent <- fi <$> xftfont_max_descent xftfonts +#else +textExtentsXMF (Xft xftfonts) _ = io $ do + ascent <- fi <$> xftfont_ascent (NE.head xftfonts) + descent <- fi <$> xftfont_descent (NE.head xftfonts) +#endif return (ascent, descent) #endif @@ -188,13 +205,17 @@ printStringXMF d p (Utf8 fs) gc fc bc x y s = io $ do setBackground d gc bc' io $ wcDrawImageString d p fs gc x y s #ifdef XFT -printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do +printStringXMF dpy drw fs@(Xft fonts) gc fc bc x y s = do let screen = defaultScreenOfDisplay dpy colormap = defaultColormapOfScreen screen visual = defaultVisualOfScreen screen bcolor <- stringToPixel dpy bc (a,d) <- textExtentsXMF fs s - gi <- io $ xftTextExtents dpy font s +#if MIN_VERSION_X11_xft(0, 3, 4) + gi <- io $ xftTextAccumExtents dpy (toList fonts) s +#else + gi <- io $ xftTextExtents dpy (NE.head fonts) s +#endif io $ setForeground dpy gc bcolor io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi)) (y - fi a) @@ -202,5 +223,9 @@ printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do (fi $ a + d) io $ withXftDraw dpy drw visual colormap $ \draw -> withXftColorName dpy visual colormap fc $ - \color -> xftDrawString draw color font x y s +#if MIN_VERSION_X11_xft(0, 3, 4) + \color -> xftDrawStringFallback draw color (toList fonts) (fi x) (fi y) s +#else + \color -> xftDrawString draw color (NE.head fonts) x y s +#endif #endif