{-# LINE 2 "./Graphics/UI/Gtk/Selectors/FileChooserDialog.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget FileChooserDialog
--
-- Author : Duncan Coutts
--
-- Created: 24 April 2004
--
-- Copyright (C) 2004-2005 Duncan Coutts
--
-- 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 file chooser dialog, suitable for \"File\/Open\" or \"File\/Save\"
-- commands
--
-- * Module available since Gtk+ version 2.4
--
module Graphics.UI.Gtk.Selectors.FileChooserDialog (
-- * Detail
--
-- | 'FileChooserDialog' is a dialog box suitable for use with \"File\/Open\"
-- or \"File\/Save as\" commands. This widget works by putting a
-- 'FileChooserWidget' inside a 'Dialog'. It exposes the 'FileChooser',
-- interface, so you can use all of the
-- 'FileChooser' functions on the file chooser dialog as well as those for
-- 'Dialog'.
--
-- Note that 'FileChooserDialog' does not have any methods of its own.
-- Instead, you should use the functions that work on a 'FileChooser'.

-- ** Response Codes
--
-- | 'FileChooserDialog' inherits from 'Dialog', so buttons that go in its
-- action area have response codes such as 'ResponseAccept' and
-- 'ResponseCancel'.

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


-- * Types
  FileChooserDialog,
  FileChooserDialogClass,
  castToFileChooserDialog, gTypeFileChooserDialog,
  toFileChooserDialog,

  -- * Constructors
  fileChooserDialogNew,
  fileChooserDialogNewWithBackend

  ) where

import Control.Monad (liftM, when)
import Data.Maybe (isJust, fromJust)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Types
{-# LINE 82 "./Graphics/UI/Gtk/Selectors/FileChooserDialog.chs" #-}
import Graphics.UI.Gtk.Selectors.FileChooser
{-# LINE 83 "./Graphics/UI/Gtk/Selectors/FileChooserDialog.chs" #-}
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Windows.Window
import Graphics.UI.Gtk.Windows.Dialog
import System.Glib.GValue (allocaGValue)
import System.Glib.GValueTypes (valueSetMaybeString)
import System.Glib.Attributes


{-# LINE 91 "./Graphics/UI/Gtk/Selectors/FileChooserDialog.chs" #-}


--------------------
-- Interfaces

instance FileChooserClass FileChooserDialog

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

-- | Creates a new 'FileChooserDialog'.
--
fileChooserDialogNew
  :: GlibString string
  => Maybe string -- ^ Title of the dialog (or default)
  -> Maybe Window -- ^ Transient parent of the dialog (or none)
  -> FileChooserAction -- ^ Open or save mode for the dialog
  -> [(string, ResponseId)] -- ^ Buttons and their response codes
  -> IO FileChooserDialog
fileChooserDialogNew :: forall string.
GlibString string =>
Maybe string
-> Maybe Window
-> FileChooserAction
-> [(string, ResponseId)]
-> IO FileChooserDialog
fileChooserDialogNew Maybe string
title Maybe Window
parent FileChooserAction
action [(string, ResponseId)]
buttons =
  Maybe string
-> Maybe Window
-> FileChooserAction
-> [(string, ResponseId)]
-> Maybe string
-> IO FileChooserDialog
forall string.
GlibString string =>
Maybe string
-> Maybe Window
-> FileChooserAction
-> [(string, ResponseId)]
-> Maybe string
-> IO FileChooserDialog
internalFileChooserDialogNew Maybe string
title Maybe Window
parent FileChooserAction
action [(string, ResponseId)]
buttons Maybe string
forall a. Maybe a
Nothing

-- | Creates a new 'FileChooserDialog' with a specified backend. This is
-- especially useful if you use 'fileChooserSetLocalOnly' to allow non-local
-- files and you use a more expressive vfs, such as gnome-vfs, to load files.
--
fileChooserDialogNewWithBackend
  :: GlibString string
  => Maybe string -- ^ Title of the dialog (or default)
  -> Maybe Window -- ^ Transient parent of the dialog (or none)
  -> FileChooserAction -- ^ Open or save mode for the dialog
  -> [(string, ResponseId)] -- ^ Buttons and their response codes
  -> string -- ^ The name of the filesystem backend to use
  -> IO FileChooserDialog
fileChooserDialogNewWithBackend :: forall string.
GlibString string =>
Maybe string
-> Maybe Window
-> FileChooserAction
-> [(string, ResponseId)]
-> string
-> IO FileChooserDialog
fileChooserDialogNewWithBackend Maybe string
title Maybe Window
parent FileChooserAction
action [(string, ResponseId)]
buttons string
backend =
  Maybe string
-> Maybe Window
-> FileChooserAction
-> [(string, ResponseId)]
-> Maybe string
-> IO FileChooserDialog
forall string.
GlibString string =>
Maybe string
-> Maybe Window
-> FileChooserAction
-> [(string, ResponseId)]
-> Maybe string
-> IO FileChooserDialog
internalFileChooserDialogNew Maybe string
title Maybe Window
parent FileChooserAction
action [(string, ResponseId)]
buttons (string -> Maybe string
forall a. a -> Maybe a
Just string
backend)

-- Annoyingly, the constructor for FileChooserDialog uses varargs so we can't
-- call it using the Haskell FFI. The GTK people do not consider this an api
-- bug, see <http:
-- The solution is to call objectNew and add the buttons manually.

internalFileChooserDialogNew :: GlibString string =>
  Maybe string -> -- Title of the dialog (or default)
  Maybe Window -> -- Transient parent of the dialog (or none)
  FileChooserAction -> -- Open or save mode for the dialog
  [(string, ResponseId)] -> -- Buttons and their response codes
  Maybe string -> -- The name of the backend to use (optional)
  IO FileChooserDialog
internalFileChooserDialogNew :: forall string.
GlibString string =>
Maybe string
-> Maybe Window
-> FileChooserAction
-> [(string, ResponseId)]
-> Maybe string
-> IO FileChooserDialog
internalFileChooserDialogNew Maybe string
title Maybe Window
parent FileChooserAction
action [(string, ResponseId)]
buttons Maybe string
backend = do
  CULong
objType <- IO CULong
gtk_file_chooser_dialog_get_type
{-# LINE 142 "./Graphics/UI/Gtk/Selectors/FileChooserDialog.chs" #-}
  dialog <-makeNewObject mkFileChooserDialog $ liftM castPtr $
           if (isJust backend)
             then allocaGValue $ \backendGValue -> do
                  valueSetMaybeString backendGValue backend
                  objectNew objType [("file-system-backend", backendGValue)]
             else objectNew objType []
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe string -> Bool
forall a. Maybe a -> Bool
isJust Maybe string
title)
       (FileChooserDialog -> [AttrOp FileChooserDialog] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
set FileChooserDialog
dialog [Attr FileChooserDialog string
forall self string.
(WindowClass self, GlibString string) =>
Attr self string
windowTitle Attr FileChooserDialog string -> string -> AttrOp FileChooserDialog
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Maybe string -> string
forall a. HasCallStack => Maybe a -> a
fromJust Maybe string
title])
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Window -> Bool
forall a. Maybe a -> Bool
isJust Maybe Window
parent)
       (FileChooserDialog -> [AttrOp FileChooserDialog] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
set FileChooserDialog
dialog [ReadWriteAttr FileChooserDialog (Maybe Window) Window
forall self parent.
(WindowClass self, WindowClass parent) =>
ReadWriteAttr self (Maybe Window) parent
windowTransientFor ReadWriteAttr FileChooserDialog (Maybe Window) Window
-> Window -> AttrOp FileChooserDialog
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Maybe Window -> Window
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Window
parent])
  FileChooserDialog
dialog FileChooserDialog -> FileChooserAction -> IO ()
forall self.
FileChooserClass self =>
self -> FileChooserAction -> IO ()
`fileChooserSetAction` FileChooserAction
action
  ((string, ResponseId) -> IO Button)
-> [(string, ResponseId)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(string
btnName, ResponseId
btnResponse) ->
          FileChooserDialog -> string -> ResponseId -> IO Button
forall self string.
(DialogClass self, GlibString string) =>
self -> string -> ResponseId -> IO Button
dialogAddButton FileChooserDialog
dialog string
btnName ResponseId
btnResponse) [(string, ResponseId)]
buttons
  FileChooserDialog -> IO FileChooserDialog
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileChooserDialog
dialog

foreign import ccall unsafe "gtk_file_chooser_dialog_get_type"
  gtk_file_chooser_dialog_get_type :: (IO CULong)