{-# LANGUAGE OverloadedStrings #-}

{-# LINE 2 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget MessageDialog
--
-- Author : Axel Simon
--
-- Created: 20 October 2006
--
-- Copyright (C) 2006 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.
--
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- A convenient message window
--
module Graphics.UI.Gtk.Windows.MessageDialog (
-- * Detail
--
-- | 'MessageDialog' presents a dialog with an image representing the type of
-- message (Error, Question, etc.) alongside some message text. It's simply a
-- convenience widget; you could construct the equivalent of 'MessageDialog'
-- from 'Dialog' without too much effort, but 'MessageDialog' saves typing.
--
-- The easiest way to do a modal message dialog is to use 'dialogRun',
-- though you can also pass in the 'DialogModal' flag, 'dialogRun'
-- automatically makes the dialog modal and waits for the user to respond to
-- it. 'dialogRun' returns when any dialog button is clicked.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----'Bin'
-- | +----'Window'
-- | +----'Dialog'
-- | +----MessageDialog
-- @

-- * Types
  MessageDialog,
  MessageDialogClass,
  castToMessageDialog, gTypeMessageDialog,
  toMessageDialog,
  MessageType(..),
  ButtonsType(..),
  DialogFlags(..),

-- * Constructors
  messageDialogNew,

  messageDialogNewWithMarkup,


-- * Methods

  messageDialogSetMarkup,


  messageDialogSetImage,


  messageDialogSetSecondaryMarkup,
  messageDialogSetSecondaryText,


-- * Attributes
  messageDialogMessageType,

  messageDialogText,
  messageDialogUseMarkup,
  messageDialogSecondaryText,
  messageDialogSecondaryUseMarkup,
  messageDialogImage,

  messageDialogButtons,

  messageDialogMessageArea,

  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Types
{-# LINE 101 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import System.Glib.Flags (Flags, fromFlags)
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)


{-# LINE 108 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}

--------------------
-- Types

-- | Specify what message icon this dialog should show.
--

--
-- * From Gtk 2.10 onwards, you can pass 'MessageOther' and supply your
-- own image using 'messageDialogSetImage'.
--

data MessageType = MessageInfo
                 | MessageWarning
                 | MessageQuestion
                 | MessageError
                 | MessageOther
                 deriving (Int -> MessageType
MessageType -> Int
MessageType -> [MessageType]
MessageType -> MessageType
MessageType -> MessageType -> [MessageType]
MessageType -> MessageType -> MessageType -> [MessageType]
(MessageType -> MessageType)
-> (MessageType -> MessageType)
-> (Int -> MessageType)
-> (MessageType -> Int)
-> (MessageType -> [MessageType])
-> (MessageType -> MessageType -> [MessageType])
-> (MessageType -> MessageType -> [MessageType])
-> (MessageType -> MessageType -> MessageType -> [MessageType])
-> Enum MessageType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MessageType -> MessageType
succ :: MessageType -> MessageType
$cpred :: MessageType -> MessageType
pred :: MessageType -> MessageType
$ctoEnum :: Int -> MessageType
toEnum :: Int -> MessageType
$cfromEnum :: MessageType -> Int
fromEnum :: MessageType -> Int
$cenumFrom :: MessageType -> [MessageType]
enumFrom :: MessageType -> [MessageType]
$cenumFromThen :: MessageType -> MessageType -> [MessageType]
enumFromThen :: MessageType -> MessageType -> [MessageType]
$cenumFromTo :: MessageType -> MessageType -> [MessageType]
enumFromTo :: MessageType -> MessageType -> [MessageType]
$cenumFromThenTo :: MessageType -> MessageType -> MessageType -> [MessageType]
enumFromThenTo :: MessageType -> MessageType -> MessageType -> [MessageType]
Enum,Int -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> [Char]
(Int -> MessageType -> ShowS)
-> (MessageType -> [Char])
-> ([MessageType] -> ShowS)
-> Show MessageType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageType -> ShowS
showsPrec :: Int -> MessageType -> ShowS
$cshow :: MessageType -> [Char]
show :: MessageType -> [Char]
$cshowList :: [MessageType] -> ShowS
showList :: [MessageType] -> ShowS
Show,MessageType -> MessageType -> Bool
(MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool) -> Eq MessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
/= :: MessageType -> MessageType -> Bool
Eq)

{-# LINE 121 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}

-- | Specify what buttons this dialog should show.
--
-- * Prebuilt sets of buttons for the dialog. If none of these choices
-- are appropriate, simply use 'ButtonsNone' then call 'dialogAddButton'.
--
data ButtonsType = ButtonsNone
                 | ButtonsOk
                 | ButtonsClose
                 | ButtonsCancel
                 | ButtonsYesNo
                 | ButtonsOkCancel
                 deriving (Enum,Show,Eq)

{-# LINE 128 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}

-- | Flags used to influence dialog construction.
--
-- * Marking a dialog as model will call 'widgetSetModal' on the dialog
-- window, the 'DialogDestroyWithParent' will call
-- 'windowSetDestroyWithParent' on the dialog window. Note that in
-- case the dialog is simply destroyed, no response signal is ever
-- emitted. Finally, 'DialogNoSeparator' omits the separator between
-- the action area and the dialog content which is preferable for
-- very simple messages, i.e. those that only contain one button.
--
data DialogFlags = DialogModal
                 | DialogDestroyWithParent
                 | DialogNoSeparator
                 deriving (Int -> DialogFlags -> ShowS
[DialogFlags] -> ShowS
DialogFlags -> [Char]
(Int -> DialogFlags -> ShowS)
-> (DialogFlags -> [Char])
-> ([DialogFlags] -> ShowS)
-> Show DialogFlags
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DialogFlags -> ShowS
showsPrec :: Int -> DialogFlags -> ShowS
$cshow :: DialogFlags -> [Char]
show :: DialogFlags -> [Char]
$cshowList :: [DialogFlags] -> ShowS
showList :: [DialogFlags] -> ShowS
Show,DialogFlags -> DialogFlags -> Bool
(DialogFlags -> DialogFlags -> Bool)
-> (DialogFlags -> DialogFlags -> Bool) -> Eq DialogFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DialogFlags -> DialogFlags -> Bool
== :: DialogFlags -> DialogFlags -> Bool
$c/= :: DialogFlags -> DialogFlags -> Bool
/= :: DialogFlags -> DialogFlags -> Bool
Eq,DialogFlags
DialogFlags -> DialogFlags -> Bounded DialogFlags
forall a. a -> a -> Bounded a
$cminBound :: DialogFlags
minBound :: DialogFlags
$cmaxBound :: DialogFlags
maxBound :: DialogFlags
Bounded)
instance Enum DialogFlags where
  fromEnum :: DialogFlags -> Int
fromEnum DialogFlags
DialogModal = Int
1
  fromEnum DialogFlags
DialogDestroyWithParent = Int
2
  fromEnum DialogFlags
DialogNoSeparator = Int
4

  toEnum :: Int -> DialogFlags
toEnum Int
1 = DialogFlags
DialogModal
  toEnum Int
2 = DialogFlags
DialogDestroyWithParent
  toEnum Int
4 = DialogFlags
DialogNoSeparator
  toEnum Int
unmatched = [Char] -> DialogFlags
forall a. HasCallStack => [Char] -> a
error ([Char]
"DialogFlags.toEnum: Cannot match " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
unmatched)

  succ DialogModal = DialogDestroyWithParent
  succ DialogDestroyWithParent = DialogNoSeparator
  succ _ = undefined

  pred DialogDestroyWithParent = DialogModal
  pred DialogNoSeparator = DialogDestroyWithParent
  pred _ = undefined

  enumFromTo x y | fromEnum x == fromEnum y = [ y ]
                 | otherwise = x : enumFromTo (succ x) y
  enumFrom x = enumFromTo x DialogNoSeparator
  enumFromThen _ _ =     error "Enum DialogFlags: enumFromThen not implemented"
  enumFromThenTo :: DialogFlags -> DialogFlags -> DialogFlags -> [DialogFlags]
enumFromThenTo DialogFlags
_ DialogFlags
_ DialogFlags
_ =     [Char] -> [DialogFlags]
forall a. HasCallStack => [Char] -> a
error [Char]
"Enum DialogFlags: enumFromThenTo not implemented"

{-# LINE 140 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}

instance Flags DialogFlags

--------------------
-- Constructors

-- | Create a new message dialog, which is a simple dialog with an icon
-- indicating the dialog type (error, warning, etc.) and some text the
-- user may want to see. When the user clicks a button a \"response\" signal
-- is emitted with response IDs from 'ResponseType'. See 'Dialog' for more
-- details.
--
messageDialogNew
  :: GlibString string
  => Maybe Window -- ^ Transient parent of the dialog (or none)
  -> [DialogFlags]
  -> MessageType
  -> ButtonsType
  -> string -- ^ The text of the message
  -> IO MessageDialog
messageDialogNew mWindow flags mType bType msg =
  withUTFString (unPrintf msg) $ \msgPtr ->
  makeNewObject mkMessageDialog $
  liftM (castPtr :: Ptr Widget -> Ptr MessageDialog) $
  call_message_dialog_new mWindow flags mType bType msgPtr


call_message_dialog_new :: Maybe Window -> [DialogFlags] ->
                           MessageType -> ButtonsType -> Ptr CChar ->
                           IO (Ptr Widget)
call_message_dialog_new :: Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> CString
-> IO (Ptr Widget)
call_message_dialog_new (Just (Window ForeignPtr Window
fPtr)) [DialogFlags]
flags MessageType
mType ButtonsType
bType CString
msgPtr =
  ForeignPtr Window
-> (Ptr Window -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
fPtr ((Ptr Window -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Window -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Window
ptr ->
    Ptr Window -> CInt -> CInt -> CInt -> CString -> IO (Ptr Widget)
message_dialog_new Ptr Window
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([DialogFlags] -> Int
forall a. Flags a => [a] -> Int
fromFlags [DialogFlags]
flags))
      (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MessageType -> Int
forall a. Enum a => a -> Int
fromEnum MessageType
mType))
      (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ButtonsType -> Int
forall a. Enum a => a -> Int
fromEnum ButtonsType
bType)) CString
msgPtr
call_message_dialog_new Maybe Window
Nothing [DialogFlags]
flags MessageType
mType ButtonsType
bType CString
msgPtr =
    Ptr Window -> CInt -> CInt -> CInt -> CString -> IO (Ptr Widget)
message_dialog_new Ptr Window
forall a. Ptr a
nullPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([DialogFlags] -> Int
forall a. Flags a => [a] -> Int
fromFlags [DialogFlags]
flags))
      (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MessageType -> Int
forall a. Enum a => a -> Int
fromEnum MessageType
mType))
      (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ButtonsType -> Int
forall a. Enum a => a -> Int
fromEnum ButtonsType
bType)) CString
msgPtr

foreign import ccall unsafe "gtk_message_dialog_new"
  message_dialog_new :: Ptr Window -> CInt -> CInt -> CInt ->
                        Ptr CChar -> IO (Ptr Widget)


-- | Creates a new message dialog, which is a simple dialog with an icon
-- indicating the dialog type (error, warning, etc.) and some text which
-- is marked up with the Pango text markup language. When the user clicks
-- a button a \"response\" signal is emitted with response IDs from
-- 'ResponseType'. See 'Dialog' and 'PangoMarkup' for more details.
--
-- * Available since Gtk+ version 2.4
--
messageDialogNewWithMarkup
  :: GlibString string
  => Maybe Window -- ^ Transient parent of the dialog (or none)
  -> [DialogFlags]
  -> MessageType
  -> ButtonsType
  -> string -- ^ The text of the message
  -> IO MessageDialog
messageDialogNewWithMarkup :: forall string.
GlibString string =>
Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> string
-> IO MessageDialog
messageDialogNewWithMarkup Maybe Window
mWindow [DialogFlags]
flags MessageType
mType ButtonsType
bType string
msg = do
  MessageDialog
md <- (ForeignPtr MessageDialog -> MessageDialog,
 FinalizerPtr MessageDialog)
-> IO (Ptr MessageDialog) -> IO MessageDialog
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr MessageDialog -> MessageDialog,
 FinalizerPtr MessageDialog)
forall {a}.
(ForeignPtr MessageDialog -> MessageDialog, FinalizerPtr a)
mkMessageDialog (IO (Ptr MessageDialog) -> IO MessageDialog)
-> IO (Ptr MessageDialog) -> IO MessageDialog
forall a b. (a -> b) -> a -> b
$
    (Ptr Widget -> Ptr MessageDialog)
-> IO (Ptr Widget) -> IO (Ptr MessageDialog)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr MessageDialog
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr MessageDialog) (IO (Ptr Widget) -> IO (Ptr MessageDialog))
-> IO (Ptr Widget) -> IO (Ptr MessageDialog)
forall a b. (a -> b) -> a -> b
$
    Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> CString
-> IO (Ptr Widget)
call_message_dialog_new Maybe Window
mWindow [DialogFlags]
flags MessageType
mType ButtonsType
bType CString
forall a. Ptr a
nullPtr
  MessageDialog -> string -> IO ()
forall self string.
(MessageDialogClass self, GlibString string) =>
self -> string -> IO ()
messageDialogSetMarkup MessageDialog
md string
msg
  MessageDialog -> IO MessageDialog
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MessageDialog
md


--------------------
-- Methods


-- | Sets the text of the message dialog to be @str@, which is marked up with
-- the Pango text markup language.
--
-- * Available since Gtk+ version 2.4
--
messageDialogSetMarkup :: (MessageDialogClass self, GlibString string) => self
 -> string -- ^ @str@ - markup string (see Pango markup format)
 -> IO ()
messageDialogSetMarkup :: forall self string.
(MessageDialogClass self, GlibString string) =>
self -> string -> IO ()
messageDialogSetMarkup self
self string
str =
  string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString (string -> string
forall s. GlibString s => s -> s
unPrintf string
str) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->
  (\(MessageDialog ForeignPtr MessageDialog
arg1) CString
arg2 -> ForeignPtr MessageDialog -> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr MessageDialog
arg1 ((Ptr MessageDialog -> IO ()) -> IO ())
-> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageDialog
argPtr1 ->Ptr MessageDialog -> CString -> IO ()
gtk_message_dialog_set_markup Ptr MessageDialog
argPtr1 CString
arg2)
{-# LINE 224 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
    (toMessageDialog self)
    CString
strPtr



messageDialogSetSecondaryMarkup :: (MessageDialogClass self, GlibString string) => self
 -> string -- ^ @str@ - markup string (see Pango markup format)
 -> IO ()
messageDialogSetSecondaryMarkup :: forall self string.
(MessageDialogClass self, GlibString string) =>
self -> string -> IO ()
messageDialogSetSecondaryMarkup self
self string
str =
  string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString (string -> string
forall s. GlibString s => s -> s
unPrintf string
str) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->
  let (MessageDialog ForeignPtr MessageDialog
fPtr) = self -> MessageDialog
forall o. MessageDialogClass o => o -> MessageDialog
toMessageDialog self
self in
  ForeignPtr MessageDialog -> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr MessageDialog
fPtr ((Ptr MessageDialog -> IO ()) -> IO ())
-> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageDialog
ptr ->
  Ptr MessageDialog -> CString -> IO ()
message_dialog_format_secondary_markup Ptr MessageDialog
ptr CString
strPtr

foreign import ccall unsafe "gtk_message_dialog_format_secondary_markup"
  message_dialog_format_secondary_markup :: Ptr MessageDialog ->
                                           Ptr CChar -> IO ()

messageDialogSetSecondaryText :: (MessageDialogClass self, GlibString string) => self
 -> string -- ^ @str@ - text to be shown as second line
 -> IO ()
messageDialogSetSecondaryText :: forall self string.
(MessageDialogClass self, GlibString string) =>
self -> string -> IO ()
messageDialogSetSecondaryText self
self string
str =
  string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
str ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->
  let (MessageDialog ForeignPtr MessageDialog
fPtr) = self -> MessageDialog
forall o. MessageDialogClass o => o -> MessageDialog
toMessageDialog self
self in
  ForeignPtr MessageDialog -> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr MessageDialog
fPtr ((Ptr MessageDialog -> IO ()) -> IO ())
-> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageDialog
ptr ->
  Ptr MessageDialog -> CString -> IO ()
message_dialog_format_secondary_text Ptr MessageDialog
ptr CString
strPtr

foreign import ccall unsafe "gtk_message_dialog_format_secondary_text"
  message_dialog_format_secondary_text :: Ptr MessageDialog ->
                                         Ptr CChar -> IO ()


-- %hash c:6cb7 d:ebdd
-- | Sets the dialog's image to @image@.
--
-- * Available since Gtk+ version 2.10
--
messageDialogSetImage :: (MessageDialogClass self, WidgetClass image) => self
 -> image -- ^ @image@ - the image
 -> IO ()
messageDialogSetImage :: forall self image.
(MessageDialogClass self, WidgetClass image) =>
self -> image -> IO ()
messageDialogSetImage self
self image
image =
  (\(MessageDialog ForeignPtr MessageDialog
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr MessageDialog -> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr MessageDialog
arg1 ((Ptr MessageDialog -> IO ()) -> IO ())
-> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageDialog
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr MessageDialog -> Ptr Widget -> IO ()
gtk_message_dialog_set_image Ptr MessageDialog
argPtr1 Ptr Widget
argPtr2)
{-# LINE 266 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
    (toMessageDialog self)
    (image -> Widget
forall o. WidgetClass o => o -> Widget
toWidget image
image)




--------------------
-- Attributes

-- | The type of message.
--
-- Default value: 'MessageInfo'
--
messageDialogMessageType :: MessageDialogClass self => Attr self MessageType
messageDialogMessageType :: forall self. MessageDialogClass self => Attr self MessageType
messageDialogMessageType = [Char] -> GType -> Attr self MessageType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
[Char] -> GType -> Attr gobj enum
newAttrFromEnumProperty [Char]
"message-type"
  GType
gtk_message_type_get_type
{-# LINE 282 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}


-- %hash c:a2fe d:e4a2
-- | The primary text of the message dialog. If the dialog has a secondary
-- text, this will appear as the title.
--
-- Default value: @Nothing@
--
-- * Available since Gtk+ version 2.10
--
messageDialogText :: (MessageDialogClass self, GlibString string) => Attr self (Maybe string)
messageDialogText :: forall self string.
(MessageDialogClass self, GlibString string) =>
Attr self (Maybe string)
messageDialogText = [Char] -> Attr self (Maybe string)
forall gobj string.
(GObjectClass gobj, GlibString string) =>
[Char] -> Attr gobj (Maybe string)
newAttrFromMaybeStringProperty [Char]
"text"

-- %hash c:e1dd d:ca3
-- | Interpret the string 'messageDialogText' as markup.
--
-- Default value: @False@
--
-- * Available since Gtk+ version 2.10
--
messageDialogUseMarkup :: MessageDialogClass self => Attr self Bool
messageDialogUseMarkup :: forall self. MessageDialogClass self => Attr self Bool
messageDialogUseMarkup = [Char] -> Attr self Bool
forall gobj. GObjectClass gobj => [Char] -> Attr gobj Bool
newAttrFromBoolProperty [Char]
"use-markup"

-- %hash c:9623 d:1fbe
-- | The secondary text of the message dialog.
--
-- Default value: @Nothing@
--
-- * Available since Gtk+ version 2.10
--
messageDialogSecondaryText :: (MessageDialogClass self, GlibString string) => Attr self (Maybe string)
messageDialogSecondaryText :: forall self string.
(MessageDialogClass self, GlibString string) =>
Attr self (Maybe string)
messageDialogSecondaryText = [Char] -> Attr self (Maybe string)
forall gobj string.
(GObjectClass gobj, GlibString string) =>
[Char] -> Attr gobj (Maybe string)
newAttrFromMaybeStringProperty [Char]
"secondary-text"

-- %hash c:1ce2 d:ca3
-- | Default value: @False@
--
-- * Available since Gtk+ version 2.10
--
messageDialogSecondaryUseMarkup :: MessageDialogClass self => Attr self Bool
messageDialogSecondaryUseMarkup :: forall self. MessageDialogClass self => Attr self Bool
messageDialogSecondaryUseMarkup = [Char] -> Attr self Bool
forall gobj. GObjectClass gobj => [Char] -> Attr gobj Bool
newAttrFromBoolProperty [Char]
"secondary-use-markup"

-- %hash c:da36 d:b7dd
-- | The image for this dialog.
--
-- * Available since Gtk+ version 2.10
--
messageDialogImage :: (MessageDialogClass self, WidgetClass widget) => ReadWriteAttr self Widget widget
messageDialogImage :: forall self widget.
(MessageDialogClass self, WidgetClass widget) =>
ReadWriteAttr self Widget widget
messageDialogImage = [Char] -> GType -> ReadWriteAttr self Widget widget
forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
[Char] -> GType -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty [Char]
"image"
                       GType
gtk_widget_get_type
{-# LINE 331 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}


-- | The buttons shown in the message dialog.
--
-- Default value: 'ButtonsNone'
--
messageDialogButtons :: MessageDialogClass self => WriteAttr self ButtonsType
messageDialogButtons :: forall self. MessageDialogClass self => WriteAttr self ButtonsType
messageDialogButtons = [Char] -> GType -> WriteAttr self ButtonsType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
[Char] -> GType -> WriteAttr gobj enum
writeAttrFromEnumProperty [Char]
"buttons"
  GType
gtk_buttons_type_get_type
{-# LINE 340 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}


-- | The 'VBox' that corresponds to the message area of this dialog.
--
-- * Available since Gtk+ version 2.22
--
messageDialogMessageArea :: MessageDialogClass self => ReadAttr self VBox
messageDialogMessageArea :: forall self. MessageDialogClass self => ReadAttr self VBox
messageDialogMessageArea = [Char] -> GType -> ReadAttr self VBox
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
[Char] -> GType -> ReadAttr gobj gobj'
readAttrFromObjectProperty [Char]
"message-area"
  GType
gtk_vbox_get_type
{-# LINE 349 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}

foreign import ccall safe "gtk_message_dialog_set_markup"
  gtk_message_dialog_set_markup :: ((Ptr MessageDialog) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "gtk_message_dialog_set_image"
  gtk_message_dialog_set_image :: ((Ptr MessageDialog) -> ((Ptr Widget) -> (IO ())))

foreign import ccall unsafe "gtk_message_type_get_type"
  gtk_message_type_get_type :: CULong

foreign import ccall unsafe "gtk_widget_get_type"
  gtk_widget_get_type :: CULong

foreign import ccall unsafe "gtk_buttons_type_get_type"
  gtk_buttons_type_get_type :: CULong

foreign import ccall unsafe "gtk_vbox_get_type"
  gtk_vbox_get_type :: CULong