{-# LINE 2 "./System/GIO/File/MountOperation.chs" #-}
-- GIMP Toolkit (GTK) Binding for Haskell: binding to gio -*-haskell-*-
--
-- Author : Andy Stewart
-- Created: 30-Apirl-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 3 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.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http:
--
-- GIO, the C library which this Haskell library depends on, is
-- available under LGPL Version 2. The documentation included with
-- this library is based on the original GIO documentation.
--
-- | Maintainer : gtk2hs-devel@lists.sourceforge.net
-- Stability : alpha
-- Portability : portable (depends on GHC)
module System.GIO.File.MountOperation (
-- * Details
--
-- | 'MountOperation' provides a mechanism for interacting with the user. It can be used for
-- authenticating mountable operations, such as loop mounting files, hard drive partitions or server
-- locations. It can also be used to ask the user questions or show a list of applications preventing
-- unmount or eject operations from completing.
--
-- Note that 'Mount'Operation is used for more than just 'Mount' objects – for example it is also used in
-- 'driveStart'.
--
-- Users should instantiate a subclass of this that implements all the various callbacks to show the
-- required dialogs, such as 'MountOperation'. If no user interaction is desired (for example when
-- automounting filesystems at login time), usually 'Nothing' can be passed, see each method taking a
-- 'MountOperation' for details.

-- * Types
   MountOperation(..),
   MountOperationClass,

-- * Enums
   MountOperationResult(..),
   AskPasswordFlags(..),
   PasswordSave(..),

-- * Methods
    mountOperationNew,
    mountOperationReply,

-- * Attributes
    mountOperationAnonymous,
    mountOperationChoice,
    mountOperationDomain,
    mountOperationPassword,
    mountOperationPasswordSave,
    mountOperationUsername,

-- * Signals

    mountOperationAborted,
    mountOperationAskPassword,
    -- askQuestion,
    mountOperationReplySignal,
    -- showProcesses,

    ) where



import Control.Monad
import System.GIO.Enums
import System.Glib.Attributes
import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GError
import System.Glib.GObject
import System.Glib.Properties
import System.Glib.Signals
import System.Glib.UTFString
import System.GIO.Signals
{-# LINE 90 "./System/GIO/File/MountOperation.chs" #-}
import System.GIO.Types
{-# LINE 91 "./System/GIO/File/MountOperation.chs" #-}


{-# LINE 93 "./System/GIO/File/MountOperation.chs" #-}

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

-- | Creates a new mount operation.
mountOperationNew :: IO MountOperation
mountOperationNew :: IO MountOperation
mountOperationNew =
    (ForeignPtr MountOperation -> MountOperation,
 FinalizerPtr MountOperation)
-> IO (Ptr MountOperation) -> IO MountOperation
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr MountOperation -> MountOperation,
 FinalizerPtr MountOperation)
forall {a}.
(ForeignPtr MountOperation -> MountOperation, FinalizerPtr a)
mkMountOperation (IO (Ptr MountOperation) -> IO MountOperation)
-> IO (Ptr MountOperation) -> IO MountOperation
forall a b. (a -> b) -> a -> b
$
    IO (Ptr MountOperation)
g_mount_operation_new
{-# LINE 102 "./System/GIO/File/MountOperation.chs" #-}

-- | Emits the "reply" signal.
mountOperationReply :: MountOperationClass op => op -> MountOperationResult -> IO ()
mountOperationReply :: forall op.
MountOperationClass op =>
op -> MountOperationResult -> IO ()
mountOperationReply op
op MountOperationResult
result =
  (\(MountOperation ForeignPtr MountOperation
arg1) CInt
arg2 -> ForeignPtr MountOperation -> (Ptr MountOperation -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr MountOperation
arg1 ((Ptr MountOperation -> IO ()) -> IO ())
-> (Ptr MountOperation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MountOperation
argPtr1 ->Ptr MountOperation -> CInt -> IO ()
g_mount_operation_reply Ptr MountOperation
argPtr1 CInt
arg2) (op -> MountOperation
forall o. MountOperationClass o => o -> MountOperation
toMountOperation op
op) ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (MountOperationResult -> Int) -> MountOperationResult -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MountOperationResult -> Int
forall a. Enum a => a -> Int
fromEnum) MountOperationResult
result)

--------------------
-- Attributes
-- | Whether to use an anonymous user when authenticating.
--
-- Default value: 'False'
mountOperationAnonymous :: MountOperationClass op => Attr op Bool
mountOperationAnonymous :: forall op. MountOperationClass op => Attr op Bool
mountOperationAnonymous = String -> Attr op Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"anonymous"

-- | The index of the user's choice when a question is asked during the mount operation. See the
-- 'askQuestion' signal.
--
-- Allowed values: >= 0
--
-- Default value: 0
mountOperationChoice :: MountOperationClass op => Attr op Int
mountOperationChoice :: forall op. MountOperationClass op => Attr op Int
mountOperationChoice = String -> Attr op Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromIntProperty String
"choice"

-- | The domain to use for the mount operation.
--
-- Default value: \"\"
mountOperationDomain :: (MountOperationClass op, GlibString string) => Attr op string
mountOperationDomain :: forall op string.
(MountOperationClass op, GlibString string) =>
Attr op string
mountOperationDomain = String -> Attr op string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"domain"

-- | The password that is used for authentication when carrying out the mount operation.
--
-- Default value: \"\"
mountOperationPassword :: (MountOperationClass op, GlibString string) => Attr op string
mountOperationPassword :: forall op string.
(MountOperationClass op, GlibString string) =>
Attr op string
mountOperationPassword = String -> Attr op string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"password"

-- | Determines if and how the password information should be saved.
--
-- Default value: 'PasswordSaveNever'
mountOperationPasswordSave :: MountOperationClass op => Attr op PasswordSave
mountOperationPasswordSave :: forall op. MountOperationClass op => Attr op PasswordSave
mountOperationPasswordSave = String -> GType -> Attr op PasswordSave
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
"password-save"
               GType
g_password_save_get_type
{-# LINE 143 "./System/GIO/File/MountOperation.chs" #-}

-- | The user name that is used for authentication when carrying out the mount operation.
--
-- Default value: \"\"
mountOperationUsername :: (MountOperationClass op, GlibString string) => Attr op string
mountOperationUsername :: forall op string.
(MountOperationClass op, GlibString string) =>
Attr op string
mountOperationUsername = String -> Attr op string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"username"

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

-- | Emitted by the backend when e.g. a device becomes unavailable while a mount operation is in
-- progress.
--
-- Implementations of 'MountOperation' should handle this signal by dismissing open password dialogs.
--
-- Since 2.20
mountOperationAborted :: MountOperationClass op => Signal op (IO ())
mountOperationAborted :: forall op. MountOperationClass op => Signal op (IO ())
mountOperationAborted = (Bool -> op -> IO () -> IO (ConnectId op)) -> Signal op (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> op -> IO () -> IO (ConnectId op)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"aborted")


-- | Emitted when a mount operation asks the user for a password.
--
-- If the message contains a line break, the first line should be presented as a heading. For example,
-- it may be used as the primary text in a 'MessageDialog'.
mountOperationAskPassword :: (MountOperationClass op, GlibString string) => Signal op (string -> string -> string -> AskPasswordFlags -> IO ())
mountOperationAskPassword :: forall op string.
(MountOperationClass op, GlibString string) =>
Signal op (string -> string -> string -> AskPasswordFlags -> IO ())
mountOperationAskPassword = (Bool
 -> op
 -> (string -> string -> string -> AskPasswordFlags -> IO ())
 -> IO (ConnectId op))
-> Signal
     op (string -> string -> string -> AskPasswordFlags -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String
-> Bool
-> op
-> (string -> string -> string -> AskPasswordFlags -> IO ())
-> IO (ConnectId op)
forall a' b' c' d obj.
(GlibString a', GlibString b', GlibString c', Enum d,
 GObjectClass obj) =>
String
-> Bool
-> obj
-> (a' -> b' -> c' -> d -> IO ())
-> IO (ConnectId obj)
connect_GLIBSTRING_GLIBSTRING_GLIBSTRING_ENUM__NONE String
"ask-password")

-- | Emitted when asking the user a question and gives a list of choices for the user to choose from.
--
-- If the message contains a line break, the first line should be presented as a heading. For example,
-- it may be used as the primary text in a 'MessageDialog'.
-- askQuestion :: MountOperationClass op => Signal op (String -> [String] -> IO ())
-- askQuestion Signal (\after obj user -> connect_GLIBSTRING_BOXED__NONE "ask-question" after obj
-- (\message choicesPtr -> do
-- choices <- peekUTFString choicesPtr
-- user str choices))

-- | Emitted when the user has replied to the mount operation.
mountOperationReplySignal :: MountOperationClass op => Signal op (MountOperationResult -> IO ())
mountOperationReplySignal :: forall op.
MountOperationClass op =>
Signal op (MountOperationResult -> IO ())
mountOperationReplySignal = (Bool
 -> op -> (MountOperationResult -> IO ()) -> IO (ConnectId op))
-> Signal op (MountOperationResult -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String
-> Bool
-> op
-> (MountOperationResult -> IO ())
-> IO (ConnectId op)
forall a obj.
(Enum a, GObjectClass obj) =>
String -> Bool -> obj -> (a -> IO ()) -> IO (ConnectId obj)
connect_ENUM__NONE String
"reply")

foreign import ccall safe "g_mount_operation_new"
  g_mount_operation_new :: (IO (Ptr MountOperation))

foreign import ccall safe "g_mount_operation_reply"
  g_mount_operation_reply :: ((Ptr MountOperation) -> (CInt -> (IO ())))

foreign import ccall unsafe "g_password_save_get_type"
  g_password_save_get_type :: CULong