Skip to content
Open
Show file tree
Hide file tree
Changes from 3 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,11 @@
# Change Log / Release Notes

## _unreleased_

* `xftOpenFont` and `xftOpenFontXlfd` now throw exceptions if opening a
font fails. (They used to return a null pointer, usually leading to
crashes.)

## 0.3.4 (2021-12-11)

* Dropped support for GHC 7.10.
Expand Down
12 changes: 10 additions & 2 deletions Graphics/X11/Xft.hsc
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE FlexibleContexts #-}

-----------------------------------------------------------------------------
-- Module : Graphics.X11.Xft
Expand Down Expand Up @@ -58,6 +59,7 @@ import Codec.Binary.UTF8.String as UTF8
import Control.Arrow ((&&&))
import Control.Monad (void)
import Data.Char (ord)
import Data.Coerce (coerce, Coercible)
import Data.Function (on)
import Data.List (foldl')
import Data.List.NonEmpty (NonEmpty)
Expand All @@ -68,6 +70,11 @@ import Foreign.C.Types

#include <X11/Xft/Xft.h>

-- I wonder how many times this has been reinvented...
-- (upstream won't accept it because of the GHCisms, I suspect)
throwIfNullXft :: Coercible a (Ptr b) => String -> IO a -> IO a
throwIfNullXft fn op = coerce $ throwIfNull fn (coerce op)

-----------------------
-- Color Handling --
-----------------------
Expand Down Expand Up @@ -172,14 +179,15 @@ foreign import ccall "XftFontOpenName"
xftFontOpen :: Display -> Screen -> String -> IO XftFont
xftFontOpen dpy screen fontname =
withCAString fontname $
\cfontname -> cXftFontOpen dpy (fi (screenNumberOfScreen screen)) cfontname
\cfontname -> throwIfNullXft "xftFontOpen" $ 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
withCAString fontname $ \cfontname -> throwIfNullXft "xftFontOpenXlfd" $
cXftFontOpenXlfd dpy (fi (screenNumberOfScreen screen)) cfontname

foreign import ccall "XftLockFace"
xftLockFace :: XftFont -> IO () -- FIXME XftLockFace returns FT_face not void
Expand Down
2 changes: 1 addition & 1 deletion X11-xft.cabal
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 1.24
name: X11-xft
version: 0.3.4
version: 0.3.5
license: BSD3
license-file: LICENSE
author: Clemens Fruhwirth
Expand Down