/gtk/Graphics/UI/Gtk/Selectors/FileChooserDialog.chs.pp

https://github.com/thiagoarrais/gtk2hs · Puppet · 152 lines · 136 code · 13 blank · 3 comment · 7 complexity · bd70b1f7ce7bf38ff3370d0ba5de5426 MD5 · raw file

  1. -- -*-haskell-*-
  2. -- GIMP Toolkit (GTK) Widget FileChooserDialog
  3. --
  4. -- Author : Duncan Coutts
  5. --
  6. -- Created: 24 April 2004
  7. --
  8. -- Copyright (C) 2004-2005 Duncan Coutts
  9. --
  10. -- This library is free software; you can redistribute it and/or
  11. -- modify it under the terms of the GNU Lesser General Public
  12. -- License as published by the Free Software Foundation; either
  13. -- version 2.1 of the License, or (at your option) any later version.
  14. --
  15. -- This library is distributed in the hope that it will be useful,
  16. -- but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  18. -- Lesser General Public License for more details.
  19. --
  20. -- |
  21. -- Maintainer : gtk2hs-users@lists.sourceforge.net
  22. -- Stability : provisional
  23. -- Portability : portable (depends on GHC)
  24. --
  25. -- A file chooser dialog, suitable for \"File\/Open\" or \"File\/Save\"
  26. -- commands
  27. --
  28. -- * Module available since Gtk+ version 2.4
  29. --
  30. module Graphics.UI.Gtk.Selectors.FileChooserDialog (
  31. -- * Detail
  32. --
  33. -- | 'FileChooserDialog' is a dialog box suitable for use with \"File\/Open\"
  34. -- or \"File\/Save as\" commands. This widget works by putting a
  35. -- 'FileChooserWidget' inside a 'Dialog'. It exposes the 'FileChooser',
  36. -- interface, so you can use all of the
  37. -- 'FileChooser' functions on the file chooser dialog as well as those for
  38. -- 'Dialog'.
  39. --
  40. -- Note that 'FileChooserDialog' does not have any methods of its own.
  41. -- Instead, you should use the functions that work on a 'FileChooser'.
  42. -- ** Response Codes
  43. --
  44. -- | 'FileChooserDialog' inherits from 'Dialog', so buttons that go in its
  45. -- action area have response codes such as 'ResponseAccept' and
  46. -- 'ResponseCancel'.
  47. -- * Class Hierarchy
  48. -- |
  49. -- @
  50. -- | 'GObject'
  51. -- | +----'Object'
  52. -- | +----'Widget'
  53. -- | +----'Container'
  54. -- | +----'Bin'
  55. -- | +----'Window'
  56. -- | +----'Dialog'
  57. -- | +----FileChooserDialog
  58. -- @
  59. #if GTK_CHECK_VERSION(2,4,0)
  60. -- * Types
  61. FileChooserDialog,
  62. FileChooserDialogClass,
  63. castToFileChooserDialog,
  64. toFileChooserDialog,
  65. -- * Constructors
  66. fileChooserDialogNew,
  67. fileChooserDialogNewWithBackend
  68. #endif
  69. ) where
  70. import Control.Monad (liftM, when)
  71. import Data.Maybe (isJust, fromJust)
  72. import System.Glib.FFI
  73. {#import Graphics.UI.Gtk.Types#}
  74. {#import Graphics.UI.Gtk.Selectors.FileChooser#}
  75. import System.Glib.GObject (objectNew)
  76. import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
  77. import Graphics.UI.Gtk.Windows.Window
  78. import Graphics.UI.Gtk.Windows.Dialog
  79. import System.Glib.GValue (allocaGValue)
  80. import System.Glib.GValueTypes (valueSetMaybeString)
  81. {# context lib="gtk" prefix="gtk" #}
  82. #if GTK_CHECK_VERSION(2,4,0)
  83. --------------------
  84. -- Interfaces
  85. instance FileChooserClass FileChooserDialog
  86. --------------------
  87. -- Constructors
  88. -- | Creates a new 'FileChooserDialog'.
  89. --
  90. fileChooserDialogNew
  91. :: Maybe String -- ^ Title of the dialog (or default)
  92. -> Maybe Window -- ^ Transient parent of the dialog (or none)
  93. -> FileChooserAction -- ^ Open or save mode for the dialog
  94. -> [(String, ResponseId)] -- ^ Buttons and their response codes
  95. -> IO FileChooserDialog
  96. fileChooserDialogNew title parent action buttons =
  97. internalFileChooserDialogNew title parent action buttons Nothing
  98. -- | Creates a new 'FileChooserDialog' with a specified backend. This is
  99. -- especially useful if you use 'fileChooserSetLocalOnly' to allow non-local
  100. -- files and you use a more expressive vfs, such as gnome-vfs, to load files.
  101. --
  102. fileChooserDialogNewWithBackend
  103. :: Maybe String -- ^ Title of the dialog (or default)
  104. -> Maybe Window -- ^ Transient parent of the dialog (or none)
  105. -> FileChooserAction -- ^ Open or save mode for the dialog
  106. -> [(String, ResponseId)] -- ^ Buttons and their response codes
  107. -> String -- ^ The name of the filesystem backend to use
  108. -> IO FileChooserDialog
  109. fileChooserDialogNewWithBackend title parent action buttons backend =
  110. internalFileChooserDialogNew title parent action buttons (Just backend)
  111. -- Annoyingly, the constructor for FileChooserDialog uses varargs so we can't
  112. -- call it using the Haskell FFI. The GTK people do not consider this an api
  113. -- bug, see <http://bugzilla.gnome.org/show_bug.cgi?id=141004>
  114. -- The solution is to call objectNew and add the buttons manually.
  115. internalFileChooserDialogNew ::
  116. Maybe String -> -- Title of the dialog (or default)
  117. Maybe Window -> -- Transient parent of the dialog (or none)
  118. FileChooserAction -> -- Open or save mode for the dialog
  119. [(String, ResponseId)] -> -- Buttons and their response codes
  120. Maybe String -> -- The name of the backend to use (optional)
  121. IO FileChooserDialog
  122. internalFileChooserDialogNew title parent action buttons backend = do
  123. objType <- {# call unsafe gtk_file_chooser_dialog_get_type #}
  124. dialog <-makeNewObject mkFileChooserDialog $ liftM castPtr $
  125. if (isJust backend)
  126. then allocaGValue $ \backendGValue -> do
  127. valueSetMaybeString backendGValue backend
  128. objectNew objType [("file-system-backend", backendGValue)]
  129. else objectNew objType []
  130. when (isJust title)
  131. (dialog `windowSetTitle` fromJust title)
  132. when (isJust parent)
  133. (dialog `windowSetTransientFor` fromJust parent)
  134. dialog `fileChooserSetAction` action
  135. mapM_ (\(btnName, btnResponse) ->
  136. dialogAddButton dialog btnName btnResponse) buttons
  137. return dialog
  138. #endif