X11-xft-0.3.4/0000755000000000000000000000000007346545000011057 5ustar0000000000000000X11-xft-0.3.4/CHANGES.md0000644000000000000000000000114007346545000012445 0ustar0000000000000000# Change Log / Release Notes ## 0.3.4 (2021-12-11) * Dropped support for GHC 7.10. * Added `xftDrawStringFallback`, which works like `xftDrawString` but supports font fallback. * Added `xftTextAccumExtents`, which works like `xftTextExtents` but possibly uses different fonts for different parts of the string and returns the accumulative extents. * Added the functions `xftfont_max_ascent`, `xftfont_max_descent`, and `xftfont_max_height` to gain information about a non-empty list of `XftFont`s. ## 0.3.3 (2021-12-01) * Fixed flipped green/blue values in XRenderColor. X11-xft-0.3.4/Graphics/X11/0000755000000000000000000000000007346545000013170 5ustar0000000000000000X11-xft-0.3.4/Graphics/X11/Xft.hsc0000644000000000000000000003654107346545000014441 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- Module : Graphics.X11.Xft -- Copyright : Clemens Fruhwirth 2007 -- -- Haskell bindings for the Xft library. -- ----------------------------------------------------------------------------- module Graphics.X11.Xft ( XftColor , xftcolor_pixel , allocaXftColor , withXftColorName , withXftColorValue , XftDraw , withXftDraw , xftDrawCreate , xftDrawCreateBitmap , xftDrawCreateAlpha , xftDrawChange , xftDrawDisplay , xftDrawDrawable , xftDrawColormap , xftDrawVisual , xftDrawDestroy , XftFont , xftfont_ascent , xftfont_max_ascent , xftfont_descent , xftfont_max_descent , xftfont_height , xftfont_max_height , xftfont_max_advance_width , xftFontOpen , xftFontOpenXlfd , xftLockFace , xftUnlockFace , xftFontCopy , xftFontClose , xftDrawGlyphs , xftDrawString , xftDrawStringFallback , xftTextExtents , xftTextAccumExtents , xftDrawRect , xftDrawSetClipRectangles , xftDrawSetSubwindowMode , xftInitFtLibrary ) where import Graphics.X11 import Graphics.X11.Xlib.Types import Graphics.X11.Xrender import Codec.Binary.UTF8.String as UTF8 import Control.Arrow ((&&&)) import Control.Monad (void) import Data.Char (ord) import Data.Function (on) import Data.List (groupBy, foldl') import Data.List.NonEmpty (NonEmpty) import Foreign hiding (void) import Foreign.C.String import Foreign.C.Types #include ----------------------- -- Color Handling -- ----------------------- newtype XftColor = XftColor (Ptr XftColor) xftcolor_pixel :: XftColor -> IO Int xftcolor_pixel (XftColor p) = peekCUShort p #{offset XftColor, pixel} -- missing xftcolor_color to get XRenderColor foreign import ccall "XftColorAllocName" cXftColorAllocName :: Display -> Visual -> Colormap -> CString -> XftColor -> IO (#type Bool) allocaXftColor :: (Ptr XftColor -> IO a) -> IO a allocaXftColor = allocaBytes (#size XftColor) withXftColorName :: Display -> Visual -> Colormap -> String -> (XftColor -> IO a) -> IO a withXftColorName d v cm name f = allocaXftColor $ (\color -> do withCAString name (\cstring -> do void $ cXftColorAllocName d v cm cstring color r <- f color cXftColorFree d v cm color return r)) . XftColor foreign import ccall "XftColorAllocValue" cXftColorAllocValue :: Display -> Visual -> Colormap -> (Ptr XRenderColor) -> XftColor -> IO (#type Bool) withXftColorValue :: Display -> Visual -> Colormap -> XRenderColor -> (XftColor -> IO a) -> IO a withXftColorValue d v cm rc f = allocaXftColor $ (\color -> do with rc (\rc_ptr -> do void $ cXftColorAllocValue d v cm rc_ptr color r <- f color cXftColorFree d v cm color return r)) . XftColor foreign import ccall "XftColorFree" cXftColorFree :: Display -> Visual -> Colormap -> XftColor -> IO () ----------------------- -- Draw Handling -- ----------------------- newtype XftDraw = XftDraw (Ptr XftDraw) withXftDraw :: Display -> Drawable -> Visual -> Colormap -> (XftDraw -> IO a) -> IO a withXftDraw d p v c act = do draw <- xftDrawCreate d p v c a <- act draw xftDrawDestroy draw return a foreign import ccall "XftDrawCreate" xftDrawCreate :: Display -> Drawable -> Visual -> Colormap -> IO XftDraw foreign import ccall "XftDrawCreateBitmap" xftDrawCreateBitmap :: Display -> Pixmap -> IO XftDraw foreign import ccall "XftDrawCreateAlpha" cXftDrawCreateAlpha :: Display -> Pixmap -> CInt -> IO XftDraw xftDrawCreateAlpha :: Integral a => Display -> Pixmap -> a -> IO XftDraw xftDrawCreateAlpha d p i = cXftDrawCreateAlpha d p (fi i) foreign import ccall "XftDrawChange" xftDrawChange :: XftDraw -> Drawable -> IO () foreign import ccall "XftDrawDisplay" xftDrawDisplay :: XftDraw -> IO Display -- FIXME correct? Is X11 giving us the underlying Display? foreign import ccall "XftDrawDrawable" xftDrawDrawable :: XftDraw -> IO Drawable foreign import ccall "XftDrawColormap" xftDrawColormap :: XftDraw -> IO Colormap foreign import ccall "XftDrawVisual" xftDrawVisual :: XftDraw -> IO Visual foreign import ccall "XftDrawDestroy" xftDrawDestroy :: XftDraw -> IO () -------------------- -- Font handling -- -------------------- newtype XftFont = XftFont (Ptr XftFont) xftfont_ascent, xftfont_descent, xftfont_height, xftfont_max_advance_width :: XftFont -> IO Int xftfont_ascent (XftFont p) = peekCUShort p #{offset XftFont, ascent} xftfont_descent (XftFont p) = peekCUShort p #{offset XftFont, descent} xftfont_height (XftFont p) = peekCUShort p #{offset XftFont, height} xftfont_max_advance_width (XftFont p) = peekCUShort p #{offset XftFont, max_advance_width} -- missing xftfont_charset -- missing xftfont_pattern foreign import ccall "XftFontOpenName" cXftFontOpen :: Display -> CInt -> CString -> IO XftFont xftFontOpen :: Display -> Screen -> String -> IO XftFont xftFontOpen dpy screen fontname = withCAString fontname $ \cfontname -> cXftFontOpen dpy (fi (screenNumberOfScreen screen)) cfontname foreign import ccall "XftFontOpenXlfd" cXftFontOpenXlfd :: Display -> CInt -> CString -> IO XftFont xftFontOpenXlfd :: Display -> Screen -> String -> IO XftFont xftFontOpenXlfd dpy screen fontname = withCAString fontname $ \cfontname -> cXftFontOpenXlfd dpy (fi (screenNumberOfScreen screen)) cfontname foreign import ccall "XftLockFace" xftLockFace :: XftFont -> IO () -- FIXME XftLockFace returns FT_face not void foreign import ccall "XftUnlockFace" xftUnlockFace :: XftFont -> IO () foreign import ccall "XftFontCopy" xftFontCopy :: Display -> XftFont -> IO XftFont foreign import ccall "XftFontClose" xftFontClose :: Display -> XftFont -> IO () -- Support for multiple fonts -- xftfont_max_ascent :: NonEmpty XftFont -> IO Int xftfont_max_ascent = fmap maximum . mapM xftfont_ascent xftfont_max_descent :: NonEmpty XftFont -> IO Int xftfont_max_descent = fmap maximum . mapM xftfont_descent xftfont_max_height :: NonEmpty XftFont -> IO Int xftfont_max_height = fmap maximum . mapM xftfont_height --------------------- -- Painting --------------------- -- Drawing strings or glyphs -- foreign import ccall "XftCharExists" cXftCharExists :: Display -> XftFont -> (#type FcChar32) -> IO (#type FcBool) xftCharExists :: Display -> XftFont -> Char -> IO Bool xftCharExists d f c = bool <$> cXftCharExists d f (fi $ ord c) where bool 0 = False bool _ = True foreign import ccall "XftDrawGlyphs" cXftDrawGlyphs :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> Ptr (#type FT_UInt) -> CInt -> IO () xftDrawGlyphs :: (Integral a, Integral b, Integral c) => XftDraw -> XftColor -> XftFont -> b -> c -> [a] -> IO () xftDrawGlyphs d c f x y glyphs = withArrayLen (map fi glyphs) (\len ptr -> cXftDrawGlyphs d c f (fi x) (fi y) ptr (fi len)) foreign import ccall "XftDrawStringUtf8" cXftDrawStringUtf8 :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> Ptr (#type FcChar8) -> CInt -> IO () xftDrawString :: (Integral a, Integral b) => XftDraw -> XftColor -> XftFont -> a -> b -> String -> IO () xftDrawString d c f x y string = withArrayLen (map fi (UTF8.encode string)) (\len ptr -> cXftDrawStringUtf8 d c f (fi x) (fi y) ptr (fi len)) -- Querying text extends for strings or glyphs -- foreign import ccall "XftTextExtentsUtf8" cXftTextExtentsUtf8 :: Display -> XftFont -> CString -> CInt -> Ptr XGlyphInfo -> IO () xftTextExtents :: Display -> XftFont -> String -> IO XGlyphInfo xftTextExtents d f string = withArrayLen (map fi (UTF8.encode string)) $ \len str_ptr -> alloca $ \cglyph -> do cXftTextExtentsUtf8 d f str_ptr (fi len) cglyph peek cglyph -- Support for multiple fonts -- -- | Like 'xftDrawString', but fall back to another font in the given -- list if necessary (i.e., should a character not be drawable with the -- currently selected font). xftDrawStringFallback :: XftDraw -> XftColor -> [XftFont] -> Int -> Int -> String -> IO () xftDrawStringFallback d c fs x y string = do display <- xftDrawDisplay d chunks <- getChunks display fs x y string mapM_ (\(f, s, (XGlyphInfo _ _ x' y' _ _)) -> xftDrawString d c f x' y' s) chunks -- | Like 'xftTextExtents' but for multiple fonts. Return -- accumulative extents using appropriate fonts for each part of -- string. xftTextAccumExtents :: Display -> [XftFont] -> String -> IO XGlyphInfo xftTextAccumExtents disp fts string = do chunks <- map (\ (_, _, gi) -> gi) <$> getChunks disp fts 0 0 string return $ foldl' calcExtents (XGlyphInfo 0 0 0 0 0 0) chunks where calcExtents :: XGlyphInfo -> XGlyphInfo -> XGlyphInfo calcExtents (XGlyphInfo _ _ x y xo yo) (XGlyphInfo w' h' _ _ xo' yo') = XGlyphInfo (xo + w') (yo + h') x y (xo + xo') (yo + yo') -- | Split string and determine fonts/offsets for individual parts getChunks :: Display -> [XftFont] -> Int -> Int -> String -> IO [(XftFont, String, XGlyphInfo)] getChunks disp fts xInit yInit str = do chunks <- getFonts fts str getChunksExtents xInit yInit chunks where -- Split string and determine fonts for individual parts getFonts :: [XftFont] -> String -> IO [(XftFont, String)] getFonts [] _ = return [] getFonts [ft] s = return [(ft, s)] getFonts fonts@(ft:_) s = do -- Determine which glyph can be rendered by current font glyphs <- mapM (xftCharExists disp ft) s -- Split string into parts that return "can/cannot be rendered" let splits = map (fst . head &&& map snd) . groupBy ((==) `on` fst) $ zip glyphs s -- Determine which font to render each chunk with concat <$> mapM (getFont fonts) splits -- Determine fonts for substrings getFont :: [XftFont] -> (Bool, String) -> IO [(XftFont, String)] getFont [] _ = return [] getFont [ft] (_, s) = return [(ft, s)] -- Last font, use it getFont (ft:_) (True, s) = return [(ft, s)] -- Current font can render this substring getFont (_:fs) (False, s) = getFonts fs s -- Fallback to next font -- Determine coordinates for chunks using extents getChunksExtents :: Int -> Int -> [(XftFont, String)] -> IO [(XftFont, String, XGlyphInfo)] getChunksExtents _ _ [] = return [] getChunksExtents x y ((f, s) : chunks) = do (XGlyphInfo w h _ _ xo yo) <- xftTextExtents disp f s rest <- getChunksExtents (x + xo) (y + yo) chunks return $ (f, s, XGlyphInfo w h x y xo yo) : rest -- Drawing auxilary -- foreign import ccall "XftDrawRect" cXftDrawRect :: XftDraw -> XftColor -> CInt -> CInt -> CUInt -> CUInt -> IO () xftDrawRect :: (Integral a, Integral b, Integral c, Integral d) => XftDraw -> XftColor -> a -> b -> c -> d -> IO () xftDrawRect draw color x y width height = cXftDrawRect draw color (fi x) (fi y) (fi width) (fi height) foreign import ccall "XftDrawSetClip" cXftDrawSetClip :: XftDraw -> Ptr Region -> IO (#type Bool) --xftDrawSetClip d (Region r) = -- do -- rv <- cXftDrawSetClip d r -- return $ (fi rv) /= 0 foreign import ccall "XftDrawSetClipRectangles" cXftDrawSetClipRectangles :: XftDraw -> CInt -> CInt -> (Ptr Rectangle) -> CInt -> IO CInt xftDrawSetClipRectangles :: XftDraw -> Int -> Int -> [Rectangle] -> IO Bool xftDrawSetClipRectangles draw x y rectangles = withArrayLen rectangles (\len rects -> do r <- cXftDrawSetClipRectangles draw (fi x) (fi y) rects (fi len) return (toInteger r /= 0)) -- verify whether this is really the convention foreign import ccall "XftDrawSetSubwindowMode" cXftDrawSetSubwindowMode :: XftDraw -> CInt -> IO () xftDrawSetSubwindowMode :: Integral a => XftDraw -> a -> IO () xftDrawSetSubwindowMode d i = cXftDrawSetSubwindowMode d (fi i) -------------- -- Auxillary -------------- foreign import ccall "XftInitFtLibrary" xftInitFtLibrary :: IO () {- These functions minimize round-trip between the library and the using program (maybe also to the X server?) but otherwise all the functions can be achieved by DrawGlyphs void XftDrawCharSpec (XftDraw *draw, _Xconst XftColor *color, XftFont *pub, _Xconst XftCharSpec *chars, int len); void XftDrawCharFontSpec (XftDraw *draw, _Xconst XftColor *color, _Xconst XftCharFontSpec *chars, int len); void XftDrawGlyphSpec (XftDraw *draw, _Xconst XftColor *color, XftFont *pub, _Xconst XftGlyphSpec *glyphs, int len); void XftDrawGlyphFontSpec (XftDraw *draw, _Xconst XftColor *color, _Xconst XftGlyphFontSpec *glyphs, int len); ------ Missing void XftGlyphExtents (Display *dpy, XftFont *pub, _Xconst FT_UInt *glyphs, int nglyphs, XGlyphInfo *extents); Intentionally Missing Bindings xftDrawString8,xftDrawString16,xftDrawString32,xftDrawStringUtf16 --foreign import ccall "XftDrawSetClip" -- cXftDrawSetClip :: XftDraw -> Ptr (??) Region -> IO (#type Bool) Missing Bindings because of missing Freetype bindings /* xftfreetype.c */ XftFontInfo * XftFontInfoCreate (Display *dpy, _Xconst FcPattern *pattern); void XftFontInfoDestroy (Display *dpy, XftFontInfo *fi); FcChar32 XftFontInfoHash (_Xconst XftFontInfo *fi); FcBool XftFontInfoEqual (_Xconst XftFontInfo *a, _Xconst XftFontInfo *b); XftFont * XftFontOpenInfo (Display *dpy, FcPattern *pattern, XftFontInfo *fi); XftFont * XftFontOpenPattern (Display *dpy, FcPattern *pattern); -- no Render bindings yet --foreign import ccall "XftDrawPicture" -- cXftDrawPicture :: XftDraw -> IO Picture --foreign import ccall "XftDrawPicture" -- cXftDrawSrcPicture :: XftDraw -> XftColor -> IO Picture -} -- | Short-hand for 'fromIntegral' fi :: (Integral a, Num b) => a -> b fi = fromIntegral X11-xft-0.3.4/Graphics/X11/Xrender.hsc0000644000000000000000000001226107346545000015300 0ustar0000000000000000----------------------------------------------------------------------------- -- Module : Graphics.X11.Xrender -- Copyright : Clemens Fruhwirth 2007 -- -- Haskell bindings for the Xrender extension. -- ----------------------------------------------------------------------------- module Graphics.X11.Xrender ( peekCUShort, pokeCUShort, peekCShort, pokeCShort, XRenderColor (..), XGlyphInfo (..), XRenderDirectFormat (..), ) where import Foreign import Foreign.C #include peekCUShort :: Ptr a -> CInt -> IO Int peekCUShort ptr off = do v <- peekByteOff ptr (fromIntegral off) return (fromIntegral (v::CUShort)) pokeCUShort :: Ptr a -> CInt -> Int -> IO () pokeCUShort ptr off v = pokeByteOff ptr (fromIntegral off) (fromIntegral v::CUShort) peekCShort :: Ptr a -> CInt -> IO Int peekCShort ptr off = do v <- peekByteOff ptr (fromIntegral off) return (fromIntegral (v::CShort)) pokeCShort :: Ptr a -> CInt -> Int -> IO () pokeCShort ptr off v = pokeByteOff ptr (fromIntegral off) (fromIntegral v::CShort) data XRenderColor = XRenderColor { xrendercolor_red :: Int, xrendercolor_green :: Int, xrendercolor_blue :: Int, xrendercolor_alpha :: Int } instance Storable XRenderColor where sizeOf _ = #{size XRenderColor} alignment _ = alignment (undefined::CInt) peek p = do red <- peekCUShort p #{offset XRenderColor, red} blue <- peekCUShort p #{offset XRenderColor, blue} green <- peekCUShort p #{offset XRenderColor, green} alpha <- peekCUShort p #{offset XRenderColor, alpha} return (XRenderColor red green blue alpha) poke p (XRenderColor red green blue alpha) = do pokeCUShort p #{offset XRenderColor,red} red pokeCUShort p #{offset XRenderColor,blue} blue pokeCUShort p #{offset XRenderColor,green} green pokeCUShort p #{offset XRenderColor,alpha} alpha data XGlyphInfo = XGlyphInfo { xglyphinfo_width :: Int, xglyphinfo_height :: Int, xglyphinfo_x :: Int, xglyphinfo_y :: Int, xglyphinfo_xOff :: Int, xglyphinfo_yOff :: Int } instance Storable XGlyphInfo where sizeOf _ = #{size XGlyphInfo} alignment _ = alignment (undefined::CInt) peek p = do width <- peekCUShort p #{offset XGlyphInfo, width} height <- peekCUShort p #{offset XGlyphInfo, height} x <- peekCShort p #{offset XGlyphInfo, x} y <- peekCShort p #{offset XGlyphInfo, y} xOff <- peekCShort p #{offset XGlyphInfo, xOff} yOff <- peekCShort p #{offset XGlyphInfo, yOff} return (XGlyphInfo width height x y xOff yOff) poke p (XGlyphInfo width height x y xOff yOff) = do pokeCUShort p #{offset XGlyphInfo,width} width pokeCUShort p #{offset XGlyphInfo,height} height pokeCShort p #{offset XGlyphInfo,x} x pokeCShort p #{offset XGlyphInfo,y} y pokeCShort p #{offset XGlyphInfo,xOff} xOff pokeCShort p #{offset XGlyphInfo,yOff} yOff data XRenderDirectFormat = XRenderDirectFormat { xrenderdirectformat_red :: Int, xrenderdirectformat_redMask :: Int, xrenderdirectformat_green :: Int, xrenderdirectformat_greenMask :: Int, xrenderdirectformat_blue :: Int, xrenderdirectformat_blueMask :: Int, xrenderdirectformat_alpha :: Int, xrenderdirectformat_alphaMask :: Int } instance Storable XRenderDirectFormat where sizeOf _ = #{size XRenderDirectFormat} alignment _ = alignment (undefined::CInt) peek p = do red <- peekCShort p #{offset XRenderDirectFormat, red} redMask <- peekCShort p #{offset XRenderDirectFormat, redMask} green <- peekCShort p #{offset XRenderDirectFormat, green} greenMask <- peekCShort p #{offset XRenderDirectFormat, greenMask} blue <- peekCShort p #{offset XRenderDirectFormat, blue} blueMask <- peekCShort p #{offset XRenderDirectFormat, blueMask} alpha <- peekCShort p #{offset XRenderDirectFormat, alpha} alphaMask <- peekCShort p #{offset XRenderDirectFormat, alphaMask} return (XRenderDirectFormat red redMask green greenMask blue blueMask alpha alphaMask) poke p (XRenderDirectFormat red redMask green greenMask blue blueMask alpha alphaMask) = do pokeCShort p #{offset XRenderDirectFormat,red} red pokeCShort p #{offset XRenderDirectFormat,redMask} redMask pokeCShort p #{offset XRenderDirectFormat,blue} blue pokeCShort p #{offset XRenderDirectFormat,blueMask} blueMask pokeCShort p #{offset XRenderDirectFormat,green} green pokeCShort p #{offset XRenderDirectFormat,greenMask} greenMask pokeCShort p #{offset XRenderDirectFormat,alpha} alpha pokeCShort p #{offset XRenderDirectFormat,alphaMask} alphaMask X11-xft-0.3.4/LICENSE0000644000000000000000000000276307346545000012074 0ustar0000000000000000Copyright (c) 2007 Clemens Fruhwirth Copyright (c) The Xmonad Community. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. X11-xft-0.3.4/README.md0000644000000000000000000000024507346545000012337 0ustar0000000000000000# Bindings to the X Free Type interface library [![Hackage](https://img.shields.io/hackage/v/X11-xft.svg?logo=haskell)](https://hackage.haskell.org/package/X11-xft) X11-xft-0.3.4/X11-xft.cabal0000644000000000000000000000254407346545000013220 0ustar0000000000000000cabal-version: 2.2 name: X11-xft version: 0.3.4 license: BSD-3-Clause license-file: LICENSE author: Clemens Fruhwirth maintainer: xmonad@haskell.org category: Graphics synopsis: Bindings to the Xft and some Xrender parts description: A Haskell bindings to the X Font library. With it, Haskell X11 applications can access high quality font renderings and provide fonts with anti-aliasing and subpixel rendering. The bindings also provide minimal bindings to Xrender parts. build-type: Simple tested-with: GHC == 8.0.2 || == 8.2.2 || == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1 || == 9.2.1 extra-source-files: CHANGES.md README.md flag pedantic description: Be pedantic (-Werror and the like) default: False manual: True library build-depends: base >= 4.9.0.0 && < 5 , X11 >= 1.2.1 , utf8-string >= 0.1 ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-binds pkgconfig-depends: xft other-extensions: ForeignFunctionInterface exposed-modules: Graphics.X11.Xft, Graphics.X11.Xrender default-language: Haskell98 if flag(pedantic) ghc-options: -Werror source-repository head type: git location: https://github.com/xmonad/X11-xft.git