{-# LINE 2 "./Graphics/Rendering/Pango/Attributes.chs" #-}
{-# OPTIONS_HADDOCK hide #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) - pango text attributes
--
-- Author : Axel Simon
--
-- Created: 20 October 2005
--
-- Copyright (C) 1999-2005 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- #hide

-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Defines text attributes.
--
module Graphics.Rendering.Pango.Attributes (
  withAttrList,
  parseMarkup,
  fromAttrList,
  readAttrList
  ) where

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GError
import System.Glib.GList
import Graphics.Rendering.Pango.Structs
import Graphics.Rendering.Pango.BasicTypes
{-# LINE 44 "./Graphics/Rendering/Pango/Attributes.chs" #-}
import Data.List ( sortBy )
import Data.Char ( ord, chr )
import Control.Monad ( liftM )


{-# LINE 49 "./Graphics/Rendering/Pango/Attributes.chs" #-}

foreign import ccall unsafe "pango_attr_list_unref"
  pango_attr_list_unref :: PangoAttrList -> IO ()

-- Create an attribute list.
withAttrList :: PangoString -> [PangoAttribute] -> (Ptr () -> IO a) -> IO a
withAttrList :: forall a.
PangoString -> [PangoAttribute] -> (Ptr () -> IO a) -> IO a
withAttrList PangoString
_ [] Ptr () -> IO a
act = Ptr () -> IO a
act Ptr ()
forall a. Ptr a
nullPtr
withAttrList (PangoString UTFCorrection
correct CInt
_ ForeignPtr CChar
_) [PangoAttribute]
pas Ptr () -> IO a
act = do
  alPtr <- IO (Ptr ())
pango_attr_list_new
{-# LINE 58 "./Graphics/Rendering/Pango/Attributes.chs" #-}
  let pas' = sortBy (\pa1 pa2 -> case compare (paStart pa1) (paStart pa2) of
                     EQ -> compare (paEnd pa1) (paEnd pa2)
                     other -> other) pas
  mapM_ (\PangoAttribute
pa -> do
           paPtr <- UTFCorrection -> PangoAttribute -> IO (Ptr ())
crAttr UTFCorrection
correct PangoAttribute
pa
           pango_attr_list_insert alPtr (castPtr paPtr)) pas'
  res <- act alPtr
  pango_attr_list_unref alPtr
  return res

-- Create a PangoAttribute.
crAttr :: UTFCorrection -> PangoAttribute -> IO CPangoAttribute
crAttr :: UTFCorrection -> PangoAttribute -> IO (Ptr ())
crAttr UTFCorrection
c AttrLanguage { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paLang :: PangoAttribute -> Language
paLang = Language
lang } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ (\(Language Ptr Language
arg1) -> Ptr Language -> IO (Ptr ())
pango_attr_language_new Ptr Language
arg1) Language
lang
crAttr UTFCorrection
c AttrFamily { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paFamily :: PangoAttribute -> DefaultGlibString
paFamily = DefaultGlibString
fam } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ DefaultGlibString -> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
forall a. DefaultGlibString -> (CString -> IO a) -> IO a
withUTFString DefaultGlibString
fam ((CString -> IO (Ptr ())) -> IO (Ptr ()))
-> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CString -> IO (Ptr ())
pango_attr_family_new
{-# LINE 74 "./Graphics/Rendering/Pango/Attributes.chs" #-}
crAttr c AttrStyle { paStart=s, paEnd=e, paStyle = style } =
  setAttrPos c s e $
  pango_attr_style_new (fromIntegral (fromEnum style))
crAttr UTFCorrection
c AttrWeight { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paWeight :: PangoAttribute -> Weight
paWeight = Weight
weight } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
  CInt -> IO (Ptr ())
pango_attr_weight_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Weight -> Int
forall a. Enum a => a -> Int
fromEnum Weight
weight))
crAttr UTFCorrection
c AttrVariant { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paVariant :: PangoAttribute -> Variant
paVariant = Variant
variant } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
  CInt -> IO (Ptr ())
pango_attr_variant_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Variant -> Int
forall a. Enum a => a -> Int
fromEnum Variant
variant))
crAttr UTFCorrection
c AttrStretch { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paStretch :: PangoAttribute -> Stretch
paStretch = Stretch
stretch } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
  CInt -> IO (Ptr ())
pango_attr_stretch_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Stretch -> Int
forall a. Enum a => a -> Int
fromEnum Stretch
stretch))
crAttr UTFCorrection
c AttrSize { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paSize :: PangoAttribute -> Double
paSize = Double
pu } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CInt -> IO (Ptr ())
pango_attr_size_new (Double -> CInt
puToInt Double
pu)

crAttr UTFCorrection
c AttrAbsSize { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paSize :: PangoAttribute -> Double
paSize = Double
pu } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CInt -> IO (Ptr ())
pango_attr_size_new_absolute (Double -> CInt
puToInt Double
pu)

crAttr UTFCorrection
c AttrFontDescription { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paFontDescription :: PangoAttribute -> FontDescription
paFontDescription = FontDescription
fd } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ (\(FontDescription ForeignPtr FontDescription
arg1) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr FontDescription -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> IO (Ptr ())
pango_attr_font_desc_new Ptr FontDescription
argPtr1) FontDescription
fd
crAttr UTFCorrection
c AttrForeground { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paColor :: PangoAttribute -> Color
paColor = Color Word16
r Word16
g Word16
b } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CUShort -> CUShort -> CUShort -> IO (Ptr ())
pango_attr_foreground_new
{-# LINE 96 "./Graphics/Rendering/Pango/Attributes.chs" #-}
  (fromIntegral r) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
g) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b)
crAttr UTFCorrection
c AttrBackground { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paColor :: PangoAttribute -> Color
paColor = Color Word16
r Word16
g Word16
b } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CUShort -> CUShort -> CUShort -> IO (Ptr ())
pango_attr_background_new
{-# LINE 99 "./Graphics/Rendering/Pango/Attributes.chs" #-}
  (fromIntegral r) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
g) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b)
crAttr UTFCorrection
c AttrUnderline { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paUnderline :: PangoAttribute -> Underline
paUnderline = Underline
underline } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
  CInt -> IO (Ptr ())
pango_attr_underline_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Underline -> Int
forall a. Enum a => a -> Int
fromEnum Underline
underline))


crAttr UTFCorrection
c AttrUnderlineColor {paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paColor :: PangoAttribute -> Color
paColor = Color Word16
r Word16
g Word16
b } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CUShort -> CUShort -> CUShort -> IO (Ptr ())
pango_attr_underline_color_new
{-# LINE 107 "./Graphics/Rendering/Pango/Attributes.chs" #-}
  (fromIntegral r) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
g) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b)

crAttr UTFCorrection
c AttrStrikethrough { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paStrikethrough :: PangoAttribute -> Bool
paStrikethrough = Bool
st } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
  CInt -> IO (Ptr ())
pango_attr_strikethrough_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
st))


crAttr UTFCorrection
c AttrStrikethroughColor {paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paColor :: PangoAttribute -> Color
paColor = Color Word16
r Word16
g Word16
b } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CUShort -> CUShort -> CUShort -> IO (Ptr ())
pango_attr_strikethrough_color_new
{-# LINE 116 "./Graphics/Rendering/Pango/Attributes.chs" #-}
  (fromIntegral r) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
g) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b)

crAttr UTFCorrection
c AttrRise { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paRise :: PangoAttribute -> Double
paRise = Double
pu } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CInt -> IO (Ptr ())
pango_attr_rise_new (Double -> CInt
puToInt Double
pu)

crAttr UTFCorrection
c AttrShape { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paInk :: PangoAttribute -> PangoRectangle
paInk = PangoRectangle
rect1, paLogical :: PangoAttribute -> PangoRectangle
paLogical = PangoRectangle
rect2 } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ (Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ())
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr PangoRectangle
rect1Ptr -> (Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ())
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr PangoRectangle
rect2Ptr -> do
    Ptr PangoRectangle -> PangoRectangle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr PangoRectangle
rect1Ptr PangoRectangle
rect1
    Ptr PangoRectangle -> PangoRectangle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr PangoRectangle
rect2Ptr PangoRectangle
rect2
    Ptr () -> Ptr () -> IO (Ptr ())
pango_attr_shape_new (Ptr PangoRectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr PangoRectangle
rect1Ptr) (Ptr PangoRectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr PangoRectangle
rect2Ptr)

crAttr UTFCorrection
c AttrScale { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paScale :: PangoAttribute -> Double
paScale = Double
scale } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
  CDouble -> IO (Ptr ())
pango_attr_scale_new (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scale)

crAttr UTFCorrection
c AttrFallback { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paFallback :: PangoAttribute -> Bool
paFallback = Bool
fb } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
  CInt -> IO (Ptr ())
pango_attr_fallback_new (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
fb)


crAttr UTFCorrection
c AttrLetterSpacing { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paLetterSpacing :: PangoAttribute -> Double
paLetterSpacing = Double
pu } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
  CInt -> IO (Ptr ())
pango_attr_letter_spacing_new (Double -> CInt
puToInt Double
pu)


crAttr UTFCorrection
c AttrGravity { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paGravity :: PangoAttribute -> PangoGravity
paGravity = PangoGravity
g } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
  CInt -> IO (Ptr ())
pango_attr_gravity_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PangoGravity -> Int
forall a. Enum a => a -> Int
fromEnum PangoGravity
g))
crAttr UTFCorrection
c AttrGravityHint { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paGravityHint :: PangoAttribute -> PangoGravityHint
paGravityHint = PangoGravityHint
g } =
  UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
  CInt -> IO (Ptr ())
pango_attr_gravity_hint_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PangoGravityHint -> Int
forall a. Enum a => a -> Int
fromEnum PangoGravityHint
g))


-- | Parse the marked-up text (see 'Graphics.Rendering.Pango.Markup.Markup'
-- format) to create a plain-text string and an attribute list.
--
-- * The attribute list is a list of lists of attribute. Each list describes
-- the attributes for the same span.
--
-- * If @accelMarker@ is not @'\0'@ (a zero character), the given character
-- will mark the character following it as an accelerator. For example,
-- @accelMarker@ might be an ampersand or underscore. All characters marked
-- as an accelerator will receive a 'UnderlineLow' attribute, and the
-- first character so marked will be returned as @accelChar@. If no
-- accelerator character is found, the @accelMarker@ character itself is
-- returned. Two @accelMarker@ characters following each other produce a
-- single literal @accelMarker@ character.
--
-- * If a parsing error occurs a 'System.Glib.GError.GError' is thrown.
--
parseMarkup ::
     (GlibString markup, GlibString string)
  => markup -- ^ the string containing markup
  -> Char -- ^ @accelMarker@ - the character that prefixes an accelerator
  -> IO ([[PangoAttribute]], Char, string) -- ^ list of attributes, the accelerator character found and the input string
  -- without markup
parseMarkup :: forall markup string.
(GlibString markup, GlibString string) =>
markup -> Char -> IO ([[PangoAttribute]], Char, string)
parseMarkup markup
markup Char
accelMarker = (Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
 -> IO ([[PangoAttribute]], Char, string))
-> (Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errPtr ->
  markup
-> (CStringLen -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a. markup -> (CStringLen -> IO a) -> IO a
forall s a. GlibString s => s -> (CStringLen -> IO a) -> IO a
withUTFStringLen markup
markup ((CStringLen -> IO ([[PangoAttribute]], Char, string))
 -> IO ([[PangoAttribute]], Char, string))
-> (CStringLen -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. (a -> b) -> a -> b
$ \(CString
markupPtr,Int
markupLen) ->
  (Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
 -> IO ([[PangoAttribute]], Char, string))
-> (Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
attrListPtr ->
  (Ptr CString -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO ([[PangoAttribute]], Char, string))
 -> IO ([[PangoAttribute]], Char, string))
-> (Ptr CString -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
strPtrPtr ->
  (Ptr CUInt -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO ([[PangoAttribute]], Char, string))
 -> IO ([[PangoAttribute]], Char, string))
-> (Ptr CUInt -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
accelPtr -> do
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CUInt
accelPtr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
accelMarker))
    success <- CString
-> CInt
-> CUInt
-> Ptr ()
-> Ptr CString
-> Ptr CUInt
-> Ptr (Ptr ())
-> IO CInt
pango_parse_markup CString
markupPtr
      (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
markupLen) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
accelMarker))
      (Ptr (Ptr ()) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr ())
attrListPtr) Ptr CString
strPtrPtr Ptr CUInt
accelPtr Ptr (Ptr ())
errPtr
    if not (toBool success) then return undefined else do
      accel <- peek accelPtr
      strPtr <- peek strPtrPtr
      str <- peekUTFString strPtr
      g_free (castPtr strPtr)
      attrList <- peek attrListPtr
      attrs <- fromAttrList (genUTFOfs str) attrList
      return (attrs, chr (fromIntegral accel), str)

type PangoAttrIterator = Ptr (())
{-# LINE 191 "./Graphics/Rendering/Pango/Attributes.chs" #-}

-- | Convert an attribute list into a list of attributes.
fromAttrList :: UTFCorrection -> PangoAttrList -> IO [[PangoAttribute]]
fromAttrList :: UTFCorrection -> Ptr () -> IO [[PangoAttribute]]
fromAttrList UTFCorrection
correct Ptr ()
attrListPtr = do
  iter <- Ptr () -> IO (Ptr ())
pango_attr_list_get_iterator Ptr ()
attrListPtr
  let readIter = do
        list <- Ptr () -> IO (Ptr ())
pango_attr_iterator_get_attrs Ptr ()
iter
        attrs <- if list==nullPtr then return [] else do
          attrPtrs <- fromGSList list
          mapM (fromAttr correct) attrPtrs
        more <- pango_attr_iterator_next iter
        if toBool more then liftM ((:) attrs) $ readIter else return []
  elems <- readIter
  pango_attr_iterator_destroy iter
  return elems

-- | Extract and delete an attribute.
--
fromAttr :: UTFCorrection -> CPangoAttribute -> IO PangoAttribute
fromAttr :: UTFCorrection -> Ptr () -> IO PangoAttribute
fromAttr UTFCorrection
correct Ptr ()
attrPtr = do
  attr <- UTFCorrection -> Ptr () -> IO PangoAttribute
readAttr UTFCorrection
correct Ptr ()
attrPtr
  pango_attribute_destroy attrPtr
  return attr

readAttrList :: UTFCorrection -> PangoAttrList -> IO [[PangoAttribute]]
readAttrList :: UTFCorrection -> Ptr () -> IO [[PangoAttribute]]
readAttrList UTFCorrection
correct Ptr ()
attrListPtr = do
  elems <- UTFCorrection -> Ptr () -> IO [[PangoAttribute]]
fromAttrList UTFCorrection
correct Ptr ()
attrListPtr
  pango_attr_list_unref attrListPtr
  return elems

foreign import ccall unsafe "pango_attr_list_new"
  pango_attr_list_new :: (IO (Ptr ()))

foreign import ccall unsafe "pango_attr_list_insert"
  pango_attr_list_insert :: ((Ptr ()) -> ((Ptr ()) -> (IO ())))

foreign import ccall unsafe "pango_attr_language_new"
  pango_attr_language_new :: ((Ptr Language) -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_family_new"
  pango_attr_family_new :: ((Ptr CChar) -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_style_new"
  pango_attr_style_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_weight_new"
  pango_attr_weight_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_variant_new"
  pango_attr_variant_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_stretch_new"
  pango_attr_stretch_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_size_new"
  pango_attr_size_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_size_new_absolute"
  pango_attr_size_new_absolute :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_font_desc_new"
  pango_attr_font_desc_new :: ((Ptr FontDescription) -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_foreground_new"
  pango_attr_foreground_new :: (CUShort -> (CUShort -> (CUShort -> (IO (Ptr ())))))

foreign import ccall unsafe "pango_attr_background_new"
  pango_attr_background_new :: (CUShort -> (CUShort -> (CUShort -> (IO (Ptr ())))))

foreign import ccall unsafe "pango_attr_underline_new"
  pango_attr_underline_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_underline_color_new"
  pango_attr_underline_color_new :: (CUShort -> (CUShort -> (CUShort -> (IO (Ptr ())))))

foreign import ccall unsafe "pango_attr_strikethrough_new"
  pango_attr_strikethrough_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_strikethrough_color_new"
  pango_attr_strikethrough_color_new :: (CUShort -> (CUShort -> (CUShort -> (IO (Ptr ())))))

foreign import ccall unsafe "pango_attr_rise_new"
  pango_attr_rise_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_shape_new"
  pango_attr_shape_new :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))

foreign import ccall unsafe "pango_attr_scale_new"
  pango_attr_scale_new :: (CDouble -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_fallback_new"
  pango_attr_fallback_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_letter_spacing_new"
  pango_attr_letter_spacing_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_gravity_new"
  pango_attr_gravity_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_gravity_hint_new"
  pango_attr_gravity_hint_new :: (CInt -> (IO (Ptr ())))

foreign import ccall unsafe "pango_parse_markup"
  pango_parse_markup :: ((Ptr CChar) -> (CInt -> (CUInt -> ((Ptr ()) -> ((Ptr (Ptr CChar)) -> ((Ptr CUInt) -> ((Ptr (Ptr ())) -> (IO CInt))))))))

foreign import ccall unsafe "g_free"
  g_free :: ((Ptr ()) -> (IO ()))

foreign import ccall unsafe "pango_attr_list_get_iterator"
  pango_attr_list_get_iterator :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_iterator_get_attrs"
  pango_attr_iterator_get_attrs :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall unsafe "pango_attr_iterator_next"
  pango_attr_iterator_next :: ((Ptr ()) -> (IO CInt))

foreign import ccall unsafe "pango_attr_iterator_destroy"
  pango_attr_iterator_destroy :: ((Ptr ()) -> (IO ()))

foreign import ccall unsafe "pango_attribute_destroy"
  pango_attribute_destroy :: ((Ptr ()) -> (IO ()))