{-# LINE 2 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Interface RecentChooser
--
-- Author : Andy Stewart
--
-- Created: 27 Mar 2010
--
-- Copyright (C) 2010 Andy Stewart
--
-- 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)
--
-- Interface implemented by widgets displaying recently used files
--
-- * Module available since Gtk+ version 2.10
--
module Graphics.UI.Gtk.Recent.RecentChooser (

-- * Detail
--
-- | 'RecentChooser' is an interface that can be implemented by widgets
-- displaying the list of recently used files. In Gtk+, the main objects that
-- implement this interface are 'RecentChooserWidget', 'RecentChooserDialog'
-- and 'RecentChooserMenu'.
--
-- Recently used files are supported since Gtk+ 2.10.

-- * Class Hierarchy
--
-- |
-- @
-- | 'GInterface'
-- | +----RecentChooser
-- @


-- * Types
  RecentChooser,
  RecentChooserClass,
  castToRecentChooser,
  toRecentChooser,

-- * Enums
  RecentChooserError(..),
  RecentSortType(..),

-- * Methods
  recentChooserSetSortFunc,
  recentChooserSetCurrentURI,
  recentChooserGetCurrentURI,
  recentChooserGetCurrentItem,
  recentChooserSelectURI,
  recentChooserUnselectURI,
  recentChooserSelectAll,
  recentChooserUnselectAll,
  recentChooserGetItems,
  recentChooserGetURIs,
  recentChooserAddFilter,
  recentChooserRemoveFilter,
  recentChooserListFilters,

-- * Attributes
  recentChooserShowPrivate,
  recentChooserShowTips,
  recentChooserShowIcons,
  recentChooserShowNotFound,
  recentChooserSelectMultiple,
  recentChooserLocalOnly,
  recentChooserLimit,
  recentChooserSortType,
  recentChooserFilter,

-- * Signals
  recentChooserSelectionChanged,
  recentChooserItemActivated,

  ) where



import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import System.Glib.GList
import System.Glib.GError (checkGError)
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Recent.RecentInfo (RecentInfo, mkRecentInfo)
import Graphics.UI.Gtk.Types
{-# LINE 105 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 106 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}


{-# LINE 108 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}

--------------------
-- Enums
-- | These identify the various errors that can occur while calling 'RecentChooser' functions.
data RecentChooserError = RecentChooserErrorNotFound
                        | RecentChooserErrorInvalidUri
                        deriving (Int -> RecentChooserError
RecentChooserError -> Int
RecentChooserError -> [RecentChooserError]
RecentChooserError -> RecentChooserError
RecentChooserError -> RecentChooserError -> [RecentChooserError]
RecentChooserError
-> RecentChooserError -> RecentChooserError -> [RecentChooserError]
(RecentChooserError -> RecentChooserError)
-> (RecentChooserError -> RecentChooserError)
-> (Int -> RecentChooserError)
-> (RecentChooserError -> Int)
-> (RecentChooserError -> [RecentChooserError])
-> (RecentChooserError
    -> RecentChooserError -> [RecentChooserError])
-> (RecentChooserError
    -> RecentChooserError -> [RecentChooserError])
-> (RecentChooserError
    -> RecentChooserError
    -> RecentChooserError
    -> [RecentChooserError])
-> Enum RecentChooserError
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 :: RecentChooserError -> RecentChooserError
succ :: RecentChooserError -> RecentChooserError
$cpred :: RecentChooserError -> RecentChooserError
pred :: RecentChooserError -> RecentChooserError
$ctoEnum :: Int -> RecentChooserError
toEnum :: Int -> RecentChooserError
$cfromEnum :: RecentChooserError -> Int
fromEnum :: RecentChooserError -> Int
$cenumFrom :: RecentChooserError -> [RecentChooserError]
enumFrom :: RecentChooserError -> [RecentChooserError]
$cenumFromThen :: RecentChooserError -> RecentChooserError -> [RecentChooserError]
enumFromThen :: RecentChooserError -> RecentChooserError -> [RecentChooserError]
$cenumFromTo :: RecentChooserError -> RecentChooserError -> [RecentChooserError]
enumFromTo :: RecentChooserError -> RecentChooserError -> [RecentChooserError]
$cenumFromThenTo :: RecentChooserError
-> RecentChooserError -> RecentChooserError -> [RecentChooserError]
enumFromThenTo :: RecentChooserError
-> RecentChooserError -> RecentChooserError -> [RecentChooserError]
Enum,RecentChooserError
RecentChooserError
-> RecentChooserError -> Bounded RecentChooserError
forall a. a -> a -> Bounded a
$cminBound :: RecentChooserError
minBound :: RecentChooserError
$cmaxBound :: RecentChooserError
maxBound :: RecentChooserError
Bounded,RecentChooserError -> RecentChooserError -> Bool
(RecentChooserError -> RecentChooserError -> Bool)
-> (RecentChooserError -> RecentChooserError -> Bool)
-> Eq RecentChooserError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecentChooserError -> RecentChooserError -> Bool
== :: RecentChooserError -> RecentChooserError -> Bool
$c/= :: RecentChooserError -> RecentChooserError -> Bool
/= :: RecentChooserError -> RecentChooserError -> Bool
Eq,Int -> RecentChooserError -> ShowS
[RecentChooserError] -> ShowS
RecentChooserError -> String
(Int -> RecentChooserError -> ShowS)
-> (RecentChooserError -> String)
-> ([RecentChooserError] -> ShowS)
-> Show RecentChooserError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecentChooserError -> ShowS
showsPrec :: Int -> RecentChooserError -> ShowS
$cshow :: RecentChooserError -> String
show :: RecentChooserError -> String
$cshowList :: [RecentChooserError] -> ShowS
showList :: [RecentChooserError] -> ShowS
Show)

{-# LINE 113 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}

-- | Used to specify the sorting method to be applied to the recently used resource list.
data RecentSortType = RecentSortNone
                    | RecentSortMru
                    | RecentSortLru
                    | RecentSortCustom
                    deriving (Bounded,Eq,Show)
instance Enum RecentSortType where
  fromEnum :: RecentSortType -> Int
fromEnum RecentSortType
RecentSortNone = Int
0
  fromEnum RecentSortType
RecentSortMru = Int
1
  fromEnum RecentSortType
RecentSortLru = Int
2
  fromEnum RecentSortType
RecentSortCustom = Int
3

  toEnum 0 = RecentSortNone
  toEnum 1 = RecentSortMru
  toEnum 2 = RecentSortLru
  toEnum 3 = RecentSortCustom
  toEnum unmatched = error ("RecentSortType.toEnum: Cannot match " ++ show unmatched)

  succ RecentSortNone = RecentSortMru
  succ RecentSortMru = RecentSortLru
  succ RecentSortLru = RecentSortCustom
  succ _ = undefined

  pred RecentSortMru = RecentSortNone
  pred RecentSortLru = RecentSortMru
  pred RecentSortCustom = RecentSortLru
  pred _ = undefined

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

{-# LINE 116 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}

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

-- | Sets the comparison function used when sorting to be @sortFunc@. If the
-- @chooser@ has the sort type set to 'RecentSortCustom' then the chooser will
-- sort using this function.
--
-- To the comparison function will be passed two 'RecentInfo' structs and @sortData@; @sortFunc@ should return a positive
-- integer if the first item comes before the second, zero if the two items are
-- equal and a negative integer if the first item comes after the second.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserSetSortFunc :: RecentChooserClass self => self
 -> (Maybe (RecentInfo -> IO Int))
 -> IO ()
recentChooserSetSortFunc self Nothing =
  (\(RecentChooser arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gtk_recent_chooser_set_sort_func argPtr1 arg2 arg3 arg4)
{-# LINE 136 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
    (toRecentChooser self) nullFunPtr nullPtr nullFunPtr
recentChooserSetSortFunc self (Just func) = do
  fPtr <- mkRecentSortFunc $ \_ infoPtr _ -> do
           info <- mkRecentInfo infoPtr
           liftM fromIntegral (func info)
  (\(RecentChooser arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gtk_recent_chooser_set_sort_func argPtr1 arg2 arg3 arg4)
{-# LINE 142 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
    (toRecentChooser self)
    fPtr
    (castFunPtrToPtr fPtr)
    destroyFunPtr

type RecentSortFunc = FunPtr (((Ptr RecentInfo) -> ((Ptr RecentInfo) -> ((Ptr ()) -> (IO CInt)))))
{-# LINE 148 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}

foreign import ccall "wrapper" mkRecentSortFunc ::
  (Ptr RecentInfo -> Ptr RecentInfo -> Ptr () -> IO (CInt))
  -> IO RecentSortFunc

-- | Sets @uri@ as the current URI for @chooser@.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserSetCurrentURI :: (RecentChooserClass self, GlibString string) => self
 -> string -- ^ @uri@ - a URI
 -> IO Bool -- ^ returns @True@ if the URI was found.
recentChooserSetCurrentURI :: forall self string.
(RecentChooserClass self, GlibString string) =>
self -> string -> IO Bool
recentChooserSetCurrentURI self
self string
uri =
  (Ptr (Ptr ()) -> IO Bool) -> (GError -> IO Bool) -> IO Bool
forall a. (Ptr (Ptr ()) -> IO a) -> (GError -> IO a) -> IO a
checkGError ( \Ptr (Ptr ())
errorPtr ->
                (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
                string -> (CString -> IO CInt) -> IO CInt
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
uri ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
uriPtr ->
                (\(RecentChooser ForeignPtr RecentChooser
arg1) CString
arg2 Ptr (Ptr ())
arg3 -> ForeignPtr RecentChooser
-> (Ptr RecentChooser -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO CInt) -> IO CInt)
-> (Ptr RecentChooser -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->Ptr RecentChooser -> CString -> Ptr (Ptr ()) -> IO CInt
gtk_recent_chooser_set_current_uri Ptr RecentChooser
argPtr1 CString
arg2 Ptr (Ptr ())
arg3)
{-# LINE 166 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
                    (self -> RecentChooser
forall o. RecentChooserClass o => o -> RecentChooser
toRecentChooser self
self)
                    CString
uriPtr
                    Ptr (Ptr ())
errorPtr)
              (\GError
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

-- | Gets the URI currently selected by @chooser@.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserGetCurrentURI :: (RecentChooserClass self, GlibString string) => self
 -> IO string -- ^ returns a newly string holding a URI.
recentChooserGetCurrentURI :: forall self string.
(RecentChooserClass self, GlibString string) =>
self -> IO string
recentChooserGetCurrentURI self
self =
  (\(RecentChooser ForeignPtr RecentChooser
arg1) -> ForeignPtr RecentChooser
-> (Ptr RecentChooser -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO CString) -> IO CString)
-> (Ptr RecentChooser -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->Ptr RecentChooser -> IO CString
gtk_recent_chooser_get_current_uri Ptr RecentChooser
argPtr1)
{-# LINE 180 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
    (toRecentChooser self)
  IO CString -> (CString -> IO string) -> IO string
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO string
forall s. GlibString s => CString -> IO s
readUTFString

-- | Gets the 'RecentInfo' currently selected by
-- @chooser@.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserGetCurrentItem :: RecentChooserClass self => self
 -> IO RecentInfo -- ^ returns a 'RecentInfo'.
                          -- Use 'recentInfoUnref' when when you have finished
                          -- using it.
recentChooserGetCurrentItem :: forall self. RecentChooserClass self => self -> IO RecentInfo
recentChooserGetCurrentItem self
self = do
  Ptr RecentInfo
info <- (\(RecentChooser ForeignPtr RecentChooser
arg1) -> ForeignPtr RecentChooser
-> (Ptr RecentChooser -> IO (Ptr RecentInfo))
-> IO (Ptr RecentInfo)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO (Ptr RecentInfo)) -> IO (Ptr RecentInfo))
-> (Ptr RecentChooser -> IO (Ptr RecentInfo))
-> IO (Ptr RecentInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->Ptr RecentChooser -> IO (Ptr RecentInfo)
gtk_recent_chooser_get_current_item Ptr RecentChooser
argPtr1) (self -> RecentChooser
forall o. RecentChooserClass o => o -> RecentChooser
toRecentChooser self
self)
  Ptr RecentInfo -> IO RecentInfo
mkRecentInfo Ptr RecentInfo
info

-- | Selects @uri@ inside @chooser@.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserSelectURI :: (RecentChooserClass self, GlibString string) => self
 -> string -- ^ @uri@ - a URI
 -> IO Bool -- ^ returns @True@ if @uri@ was found.
recentChooserSelectURI :: forall self string.
(RecentChooserClass self, GlibString string) =>
self -> string -> IO Bool
recentChooserSelectURI self
self string
uri =
  (Ptr (Ptr ()) -> IO Bool) -> (GError -> IO Bool) -> IO Bool
forall a. (Ptr (Ptr ()) -> IO a) -> (GError -> IO a) -> IO a
checkGError ( \Ptr (Ptr ())
errorPtr ->
                (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
                string -> (CString -> IO CInt) -> IO CInt
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
uri ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
uriPtr ->
                (\(RecentChooser ForeignPtr RecentChooser
arg1) CString
arg2 Ptr (Ptr ())
arg3 -> ForeignPtr RecentChooser
-> (Ptr RecentChooser -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO CInt) -> IO CInt)
-> (Ptr RecentChooser -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->Ptr RecentChooser -> CString -> Ptr (Ptr ()) -> IO CInt
gtk_recent_chooser_select_uri Ptr RecentChooser
argPtr1 CString
arg2 Ptr (Ptr ())
arg3)
{-# LINE 210 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
                    (self -> RecentChooser
forall o. RecentChooserClass o => o -> RecentChooser
toRecentChooser self
self)
                    CString
uriPtr
                    Ptr (Ptr ())
errorPtr)
              (\GError
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

-- | Unselects @uri@ inside @chooser@.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserUnselectURI :: (RecentChooserClass self, GlibString string) => self
 -> string -- ^ @uri@ - a URI
 -> IO ()
recentChooserUnselectURI :: forall self string.
(RecentChooserClass self, GlibString string) =>
self -> string -> IO ()
recentChooserUnselectURI self
self string
uri =
  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
uri ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
uriPtr ->
  (\(RecentChooser ForeignPtr RecentChooser
arg1) CString
arg2 -> ForeignPtr RecentChooser -> (Ptr RecentChooser -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO ()) -> IO ())
-> (Ptr RecentChooser -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->Ptr RecentChooser -> CString -> IO ()
gtk_recent_chooser_unselect_uri Ptr RecentChooser
argPtr1 CString
arg2)
{-# LINE 226 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
    (toRecentChooser self)
    CString
uriPtr

-- | Selects all the items inside @chooser@, if the @chooser@ supports
-- multiple selection.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserSelectAll :: RecentChooserClass self => self -> IO ()
recentChooserSelectAll :: forall self. RecentChooserClass self => self -> IO ()
recentChooserSelectAll self
self =
  (\(RecentChooser ForeignPtr RecentChooser
arg1) -> ForeignPtr RecentChooser -> (Ptr RecentChooser -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO ()) -> IO ())
-> (Ptr RecentChooser -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->Ptr RecentChooser -> IO ()
gtk_recent_chooser_select_all Ptr RecentChooser
argPtr1)
{-# LINE 238 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
    (toRecentChooser self)

-- | Unselects all the items inside @chooser@.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserUnselectAll :: RecentChooserClass self => self -> IO ()
recentChooserUnselectAll :: forall self. RecentChooserClass self => self -> IO ()
recentChooserUnselectAll self
self =
  (\(RecentChooser ForeignPtr RecentChooser
arg1) -> ForeignPtr RecentChooser -> (Ptr RecentChooser -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO ()) -> IO ())
-> (Ptr RecentChooser -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->Ptr RecentChooser -> IO ()
gtk_recent_chooser_unselect_all Ptr RecentChooser
argPtr1)
{-# LINE 248 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
    (toRecentChooser self)

-- | Gets the list of recently used resources in form of 'RecentInfo'
--
-- The return value of this function is affected by the \"sort-type\" and
-- \"limit\" properties of @chooser@.
--
recentChooserGetItems :: RecentChooserClass self => self
 -> IO [RecentInfo] -- ^ returns A list of 'RecentInfo' objects.
recentChooserGetItems :: forall self. RecentChooserClass self => self -> IO [RecentInfo]
recentChooserGetItems self
self = do
  Ptr ()
glist <- (\(RecentChooser ForeignPtr RecentChooser
arg1) -> ForeignPtr RecentChooser
-> (Ptr RecentChooser -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr RecentChooser -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->Ptr RecentChooser -> IO (Ptr ())
gtk_recent_chooser_get_items Ptr RecentChooser
argPtr1) (self -> RecentChooser
forall o. RecentChooserClass o => o -> RecentChooser
toRecentChooser self
self)
  [Ptr RecentInfo]
list <- Ptr () -> IO [Ptr RecentInfo]
forall a. Ptr () -> IO [Ptr a]
fromGList Ptr ()
glist
  (Ptr RecentInfo -> IO RecentInfo)
-> [Ptr RecentInfo] -> IO [RecentInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr RecentInfo -> IO RecentInfo
mkRecentInfo [Ptr RecentInfo]
list

-- | Gets the URI of the recently used resources.
--
-- The return value of this function is affected by the \"sort-type\" and
-- \"limit\" properties of @chooser@.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserGetURIs :: (RecentChooserClass self, GlibString string) => self
 -> IO [string]
recentChooserGetURIs :: forall self string.
(RecentChooserClass self, GlibString string) =>
self -> IO [string]
recentChooserGetURIs self
self =
  (Ptr CUInt -> IO [string]) -> IO [string]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO [string]) -> IO [string])
-> (Ptr CUInt -> IO [string]) -> IO [string]
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
lengthPtr -> do
  Ptr CString
str <- (\(RecentChooser ForeignPtr RecentChooser
arg1) Ptr CUInt
arg2 -> ForeignPtr RecentChooser
-> (Ptr RecentChooser -> IO (Ptr CString)) -> IO (Ptr CString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO (Ptr CString)) -> IO (Ptr CString))
-> (Ptr RecentChooser -> IO (Ptr CString)) -> IO (Ptr CString)
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->Ptr RecentChooser -> Ptr CUInt -> IO (Ptr CString)
gtk_recent_chooser_get_uris Ptr RecentChooser
argPtr1 Ptr CUInt
arg2)
{-# LINE 275 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
          (self -> RecentChooser
forall o. RecentChooserClass o => o -> RecentChooser
toRecentChooser self
self)
          Ptr CUInt
lengthPtr
  CUInt
length <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
lengthPtr
  (CString -> IO string) -> [CString] -> IO [string]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString ([CString] -> IO [string]) -> IO [CString] -> IO [string]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Ptr CString -> IO [CString]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
length) Ptr CString
str

-- | Adds @filter@ to the list of 'RecentFilter' objects held by @chooser@.
--
-- If no previous filter objects were defined, this function will call
-- 'recentChooserSetFilter'.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserAddFilter :: (RecentChooserClass self, RecentFilterClass filter) => self
 -> filter -- ^ @filter@ - a 'RecentFilter'
 -> IO ()
recentChooserAddFilter :: forall self filter.
(RecentChooserClass self, RecentFilterClass filter) =>
self -> filter -> IO ()
recentChooserAddFilter self
self filter
filter =
  (\(RecentChooser ForeignPtr RecentChooser
arg1) (RecentFilter ForeignPtr RecentFilter
arg2) -> ForeignPtr RecentChooser -> (Ptr RecentChooser -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO ()) -> IO ())
-> (Ptr RecentChooser -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->ForeignPtr RecentFilter -> (Ptr RecentFilter -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentFilter
arg2 ((Ptr RecentFilter -> IO ()) -> IO ())
-> (Ptr RecentFilter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr RecentFilter
argPtr2 ->Ptr RecentChooser -> Ptr RecentFilter -> IO ()
gtk_recent_chooser_add_filter Ptr RecentChooser
argPtr1 Ptr RecentFilter
argPtr2)
{-# LINE 293 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
    (toRecentChooser self)
    (filter -> RecentFilter
forall o. RecentFilterClass o => o -> RecentFilter
toRecentFilter filter
filter)

-- | Removes @filter@ from the list of 'RecentFilter' objects held by
-- @chooser@.
--
recentChooserRemoveFilter :: (RecentChooserClass self, RecentFilterClass filter) => self
 -> filter -- ^ @filter@ - a 'RecentFilter'
 -> IO ()
recentChooserRemoveFilter :: forall self filter.
(RecentChooserClass self, RecentFilterClass filter) =>
self -> filter -> IO ()
recentChooserRemoveFilter self
self filter
filter =
  (\(RecentChooser ForeignPtr RecentChooser
arg1) (RecentFilter ForeignPtr RecentFilter
arg2) -> ForeignPtr RecentChooser -> (Ptr RecentChooser -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO ()) -> IO ())
-> (Ptr RecentChooser -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->ForeignPtr RecentFilter -> (Ptr RecentFilter -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentFilter
arg2 ((Ptr RecentFilter -> IO ()) -> IO ())
-> (Ptr RecentFilter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr RecentFilter
argPtr2 ->Ptr RecentChooser -> Ptr RecentFilter -> IO ()
gtk_recent_chooser_remove_filter Ptr RecentChooser
argPtr1 Ptr RecentFilter
argPtr2)
{-# LINE 304 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
    (toRecentChooser self)
    (filter -> RecentFilter
forall o. RecentFilterClass o => o -> RecentFilter
toRecentFilter filter
filter)

-- | Gets the 'RecentFilter' objects held by @chooser@.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserListFilters :: RecentChooserClass self => self
 -> IO [RecentFilter] -- ^ returns A singly linked list of 'RecentFilter'.
recentChooserListFilters :: forall self. RecentChooserClass self => self -> IO [RecentFilter]
recentChooserListFilters self
self = do
  Ptr ()
glist <- (\(RecentChooser ForeignPtr RecentChooser
arg1) -> ForeignPtr RecentChooser
-> (Ptr RecentChooser -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RecentChooser
arg1 ((Ptr RecentChooser -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr RecentChooser -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr RecentChooser
argPtr1 ->Ptr RecentChooser -> IO (Ptr ())
gtk_recent_chooser_list_filters Ptr RecentChooser
argPtr1)
{-# LINE 316 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}
          (self -> RecentChooser
forall o. RecentChooserClass o => o -> RecentChooser
toRecentChooser self
self)
  [Ptr Any]
list <- Ptr () -> IO [Ptr Any]
forall a. Ptr () -> IO [Ptr a]
fromGList Ptr ()
glist
  (Ptr Any -> IO RecentFilter) -> [Ptr Any] -> IO [RecentFilter]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Ptr Any
x -> (ForeignPtr RecentFilter -> RecentFilter,
 FinalizerPtr RecentFilter)
-> IO (Ptr RecentFilter) -> IO RecentFilter
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr RecentFilter -> RecentFilter,
 FinalizerPtr RecentFilter)
forall {a}.
(ForeignPtr RecentFilter -> RecentFilter, FinalizerPtr a)
mkRecentFilter (Ptr RecentFilter -> IO (Ptr RecentFilter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> Ptr RecentFilter
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
x))) [Ptr Any]
list

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

-- | Whether the private items should be displayed.
--
-- Default value: 'False'
--
-- * Available since Gtk+ version 2.10
--
recentChooserShowPrivate :: RecentChooserClass self => Attr self Bool
recentChooserShowPrivate :: forall self. RecentChooserClass self => Attr self Bool
recentChooserShowPrivate = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"show-private"

-- | Whether this 'RecentChooser' should display a tooltip containing the full path of the recently used
-- resources.
--
-- Default value: 'False'
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserShowTips :: RecentChooserClass self => Attr self Bool
recentChooserShowTips :: forall self. RecentChooserClass self => Attr self Bool
recentChooserShowTips = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"show-tips"

-- | Whether this 'RecentChooser' should display an icon near the item.
--
-- Default value: 'True'
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserShowIcons :: RecentChooserClass self => Attr self Bool
recentChooserShowIcons :: forall self. RecentChooserClass self => Attr self Bool
recentChooserShowIcons = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"show-icons"

-- | Whether this 'RecentChooser' should display the recently used resources even if not present
-- anymore. Setting this to 'False' will perform a potentially expensive check on every local resource
-- (every remote resource will always be displayed).
--
-- Default value: 'True'
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserShowNotFound :: RecentChooserClass self => Attr self Bool
recentChooserShowNotFound :: forall self. RecentChooserClass self => Attr self Bool
recentChooserShowNotFound = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"show-not-found"

-- | Allow the user to select multiple resources.
--
-- Default value: 'False'
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserSelectMultiple :: RecentChooserClass self => Attr self Bool
recentChooserSelectMultiple :: forall self. RecentChooserClass self => Attr self Bool
recentChooserSelectMultiple = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"select-multiple"

-- | Whether this 'RecentChooser' should display only local (file:) resources.
--
-- Default value: 'True'
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserLocalOnly :: RecentChooserClass self => Attr self Bool
recentChooserLocalOnly :: forall self. RecentChooserClass self => Attr self Bool
recentChooserLocalOnly = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"local-only"

-- | The maximum number of recently used resources to be displayed, or -1 to display all items. By
-- default, the 'Setting':gtk-recent-files-limit setting is respected: you can override that limit on
-- a particular instance of 'RecentChooser' by setting this property.
--
-- Allowed values: >= 'GMaxulong'
--
-- Default value: -1
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserLimit :: RecentChooserClass self => Attr self Int
recentChooserLimit :: forall self. RecentChooserClass self => Attr self Int
recentChooserLimit = String -> Attr self Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromIntProperty String
"limit"

-- | Sorting order to be used when displaying the recently used resources.
--
-- Default value: ''RecentSortNone''
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserSortType :: RecentChooserClass self => Attr self RecentSortType
recentChooserSortType :: forall self. RecentChooserClass self => Attr self RecentSortType
recentChooserSortType = String -> CUInt -> Attr self RecentSortType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> CUInt -> Attr gobj enum
newAttrFromEnumProperty String
"sort-type"
                          CUInt
gtk_recent_sort_type_get_type
{-# LINE 409 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}

-- | The 'RecentFilter' object to be used when displaying the recently used resources.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserFilter :: (RecentChooserClass self, RecentFilterClass recentFilter) => ReadWriteAttr self RecentFilter recentFilter
recentChooserFilter :: forall self recentFilter.
(RecentChooserClass self, RecentFilterClass recentFilter) =>
ReadWriteAttr self RecentFilter recentFilter
recentChooserFilter = String -> CUInt -> ReadWriteAttr self RecentFilter recentFilter
forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
String -> CUInt -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty String
"filter"
                        CUInt
gtk_recent_filter_get_type
{-# LINE 418 "./Graphics/UI/Gtk/Recent/RecentChooser.chs" #-}

--------------------
-- Signals

-- | This signal is emitted when there is a change in the set of selected
-- recently used resources. This can happen when a user modifies the selection
-- with the mouse or the keyboard, or when explicitly calling functions to
-- change the selection.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserSelectionChanged :: RecentChooserClass self => Signal self (IO ())
recentChooserSelectionChanged :: forall self. RecentChooserClass self => Signal self (IO ())
recentChooserSelectionChanged = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"selection_changed")

-- | This signal is emitted when the user \"activates\" a recent item in the
-- recent chooser. This can happen by double-clicking on an item in the
-- recently used resources list, or by pressing Enter.
--
--
-- * Available since Gtk+ version 2.10
--
recentChooserItemActivated :: RecentChooserClass self => Signal self (IO ())
recentChooserItemActivated :: forall self. RecentChooserClass self => Signal self (IO ())
recentChooserItemActivated = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"item_activated")

foreign import ccall safe "gtk_recent_chooser_set_sort_func"
  gtk_recent_chooser_set_sort_func :: ((Ptr RecentChooser) -> ((FunPtr ((Ptr RecentInfo) -> ((Ptr RecentInfo) -> ((Ptr ()) -> (IO CInt))))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO ())))))

foreign import ccall safe "gtk_recent_chooser_set_current_uri"
  gtk_recent_chooser_set_current_uri :: ((Ptr RecentChooser) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO CInt))))

foreign import ccall safe "gtk_recent_chooser_get_current_uri"
  gtk_recent_chooser_get_current_uri :: ((Ptr RecentChooser) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_recent_chooser_get_current_item"
  gtk_recent_chooser_get_current_item :: ((Ptr RecentChooser) -> (IO (Ptr RecentInfo)))

foreign import ccall safe "gtk_recent_chooser_select_uri"
  gtk_recent_chooser_select_uri :: ((Ptr RecentChooser) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO CInt))))

foreign import ccall safe "gtk_recent_chooser_unselect_uri"
  gtk_recent_chooser_unselect_uri :: ((Ptr RecentChooser) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "gtk_recent_chooser_select_all"
  gtk_recent_chooser_select_all :: ((Ptr RecentChooser) -> (IO ()))

foreign import ccall safe "gtk_recent_chooser_unselect_all"
  gtk_recent_chooser_unselect_all :: ((Ptr RecentChooser) -> (IO ()))

foreign import ccall safe "gtk_recent_chooser_get_items"
  gtk_recent_chooser_get_items :: ((Ptr RecentChooser) -> (IO (Ptr ())))

foreign import ccall safe "gtk_recent_chooser_get_uris"
  gtk_recent_chooser_get_uris :: ((Ptr RecentChooser) -> ((Ptr CUInt) -> (IO (Ptr (Ptr CChar)))))

foreign import ccall safe "gtk_recent_chooser_add_filter"
  gtk_recent_chooser_add_filter :: ((Ptr RecentChooser) -> ((Ptr RecentFilter) -> (IO ())))

foreign import ccall safe "gtk_recent_chooser_remove_filter"
  gtk_recent_chooser_remove_filter :: ((Ptr RecentChooser) -> ((Ptr RecentFilter) -> (IO ())))

foreign import ccall safe "gtk_recent_chooser_list_filters"
  gtk_recent_chooser_list_filters :: ((Ptr RecentChooser) -> (IO (Ptr ())))

foreign import ccall unsafe "gtk_recent_sort_type_get_type"
  gtk_recent_sort_type_get_type :: CUInt

foreign import ccall unsafe "gtk_recent_filter_get_type"
  gtk_recent_filter_get_type :: CUInt