1{-# LANGUAGE CPP #-} 2-- -*-haskell-*- 3-- GIMP Toolkit (GTK) Widget Dialog 4-- 5-- Author : Axel Simon, Andy Stewart 6-- 7-- Created: 23 May 2001 8-- 9-- Copyright (C) 1999-2005 Axel Simon 10-- Copyright (C) 2009-2010 Andy Stewart 11-- 12-- This library is free software; you can redistribute it and/or 13-- modify it under the terms of the GNU Lesser General Public 14-- License as published by the Free Software Foundation; either 15-- version 2.1 of the License, or (at your option) any later version. 16-- 17-- This library is distributed in the hope that it will be useful, 18-- but WITHOUT ANY WARRANTY; without even the implied warranty of 19-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 20-- Lesser General Public License for more details. 21-- 22-- | 23-- Maintainer : gtk2hs-users@lists.sourceforge.net 24-- Stability : provisional 25-- Portability : portable (depends on GHC) 26-- 27-- Create popup windows 28-- 29-- NOTE: 30-- Now FFI haven't support variadic function `gtk_dialog_set_alternative_button_order` 31-- 32module Graphics.UI.Gtk.Windows.Dialog ( 33-- * Detail 34-- 35-- | Dialog boxes are a convenient way to prompt the user for a small amount 36-- of input, e.g. to display a message, ask a question, or anything else that 37-- does not require extensive effort on the user's part. 38-- 39-- Gtk+ treats a dialog as a window split vertically. The top section is a 40-- 'VBox', and is where widgets such as a 'Label' or a 'Entry' should be 41-- packed. The bottom area is known as the action_area. This is generally used 42-- for packing buttons into the dialog which may perform functions such as 43-- cancel, ok, or apply. The two areas are separated by a 'HSeparator'. 44-- 45-- 'Dialog' boxes are created with a call to 'dialogNew' or 46-- 'dialogNewWithButtons'. 'dialogNewWithButtons' is recommended; it allows you 47-- to set the dialog title, some convenient flags, and add simple buttons. 48-- 49-- If \'dialog\' is a newly created dialog, the two primary areas of the 50-- window can be accessed using 'dialogGetUpper' and 51-- 'dialogGetActionArea'. 52-- 53-- A \'modal\' dialog (that is, one which freezes the rest of the 54-- application from user input), can be created by calling 'windowSetModal' on 55-- the dialog. When using 'dialogNewWithButtons' you can also 56-- pass the 'DialogModal' flag to make a dialog modal. 57-- 58-- If you add buttons to 'Dialog' using 'dialogNewWithButtons', 59-- 'dialogAddButton', or 'dialogAddActionWidget', clicking 60-- the button will emit a signal called \"response\" with a response ID that 61-- you specified. Gtk+ will never assign a meaning to positive response IDs; 62-- these are entirely user-defined. But for convenience, you can use the 63-- response IDs in the 'ResponseType' enumeration (these all have values less 64-- than zero). If a dialog receives a delete event, the \"response\" signal 65-- will be emitted with a response ID of 'ResponseNone'. 66-- 67-- If you want to block waiting for a dialog to return before returning 68-- control flow to your code, you can call 'dialogRun'. This function enters a 69-- recursive main loop and waits for the user to respond to the dialog, 70-- returning the response ID corresponding to the button the user clicked. 71-- 72-- For a simple message box, you probably want to use 73-- 'Graphics.UI.Gtk.Windows.MessageDialog.MessageDialog' which provides 74-- convenience functions 75-- for creating standard dialogs containing simple messages to inform 76-- or ask the user. 77 78-- * Class Hierarchy 79-- | 80-- @ 81-- | 'GObject' 82-- | +----'Object' 83-- | +----'Widget' 84-- | +----'Container' 85-- | +----'Bin' 86-- | +----'Window' 87-- | +----Dialog 88-- | +----'AboutDialog' 89-- | +----'ColorSelectionDialog' 90-- | +----'FileChooserDialog' 91-- | +----'FileSelection' 92-- | +----'FontSelectionDialog' 93-- | +----'InputDialog' 94-- | +----'MessageDialog' 95-- @ 96 97-- * Types 98 Dialog, 99 DialogClass, 100 castToDialog, gTypeDialog, 101 toDialog, 102 103-- * Enums 104 ResponseId(..), 105 106-- * Constructors 107 dialogNew, 108 109-- * Methods 110#if GTK_MAJOR_VERSION < 3 111 dialogGetUpper, 112#endif 113 dialogGetContentArea, 114 dialogGetActionArea, 115 dialogRun, 116 dialogResponse, 117 dialogAddButton, 118 dialogAddActionWidget, 119 dialogSetDefaultResponse, 120#if GTK_MAJOR_VERSION < 3 121 dialogGetHasSeparator, 122 dialogSetHasSeparator, 123#endif 124 dialogSetResponseSensitive, 125 dialogGetResponseForWidget, 126 dialogAlternativeDialogButtonOrder, 127 dialogSetAlternativeButtonOrderFromArray, 128#if GTK_CHECK_VERSION(2,20,0) 129 dialogGetWidgetForResponse, 130#endif 131 132-- * Attributes 133#if GTK_MAJOR_VERSION < 3 134 dialogHasSeparator, 135#endif 136 dialogActionAreaBorder, 137 dialogButtonSpacing, 138 dialogContentAreaBorder, 139 dialogContentAreaSpacing, 140 141-- * Signals 142 response, 143 144-- * Deprecated 145#ifndef DISABLE_DEPRECATED 146 onResponse, 147 afterResponse, 148#endif 149 ) where 150 151import Control.Monad (liftM) 152 153import System.Glib.FFI 154import System.Glib.UTFString 155import System.Glib.Attributes 156import System.Glib.Properties 157import Graphics.UI.Gtk.Abstract.Object (makeNewObject) 158{#import Graphics.UI.Gtk.Types#} 159{#import Graphics.UI.Gtk.Signals#} 160import Graphics.UI.Gtk.General.Structs ( 161#if GTK_MAJOR_VERSION < 3 162 dialogGetUpper, dialogGetActionArea, 163#endif 164 ResponseId(..), fromResponse, toResponse) 165 166{# context lib="gtk" prefix="gtk" #} 167 168-------------------- 169-- Constructors 170 171-- | Creates a new dialog box. Widgets should not be packed into this 'Window' 172-- directly, but into the \"upper\" and \"action area\", which are obtained 173-- using 'dialogGetUpper' and 'dialogGetActionArea'. 174-- 175dialogNew :: IO Dialog 176dialogNew = 177 makeNewObject mkDialog $ 178 liftM (castPtr :: Ptr Widget -> Ptr Dialog) $ 179 {# call unsafe dialog_new #} 180 181-------------------- 182-- Methods 183 184-- | Blocks in a recursive main loop until the dialog either emits the 185-- response signal, or is destroyed. If the dialog is destroyed during the call 186-- to 'dialogRun', it returns 'ResponseNone'. Otherwise, it returns the 187-- response ID from the \"response\" signal emission. Before entering the 188-- recursive main loop, 'dialogRun' calls 'widgetShow' on the dialog for you. 189-- Note that you still need to show any children of the dialog yourself. 190-- 191-- During 'dialogRun', the default behavior of \"delete_event\" is disabled; 192-- if the dialog receives \"delete_event\", it will not be destroyed as windows 193-- usually are, and 'dialogRun' will return 'ResponseDeleteEvent'. Also, during 194-- 'dialogRun' the dialog will be modal. You can force 'dialogRun' to return at 195-- any time by calling 'dialogResponse' to emit the \"response\" signal. 196-- Destroying the dialog during 'dialogRun' is a very bad idea, because your 197-- post-run code won't know whether the dialog was destroyed or not. 198-- Hence, you should not call 'Graphics.UI.Gtk.Abstract.widgetDestroy' 199-- before 'dialogRun' has returned. 200-- 201-- After 'dialogRun' returns, you are responsible for hiding or destroying 202-- the dialog if you wish to do so. 203-- 204-- Note that even though the recursive main loop gives the effect of a modal 205-- dialog (it prevents the user from interacting with other windows while the 206-- dialog is run), callbacks such as timeouts, IO channel watches, DND drops, 207-- etc, /will/ be triggered during a 'dialogRun' call. 208-- 209dialogRun :: DialogClass self => self 210 -> IO ResponseId 211dialogRun self = 212 liftM toResponse $ 213 {# call dialog_run #} 214 (toDialog self) 215 216-- | Emits the \"response\" signal with the given response ID. Used to 217-- indicate that the user has responded to the dialog in some way; typically 218-- either you or 'dialogRun' will be monitoring the \"response\" signal and 219-- take appropriate action. 220-- 221-- This function can be used to add a custom widget to the action area that 222-- should close the dialog when activated or to close the dialog otherwise. 223-- 224dialogResponse :: DialogClass self => self 225 -> ResponseId 226 -> IO () 227dialogResponse self responseId = 228 {# call dialog_response #} 229 (toDialog self) 230 (fromResponse responseId) 231 232-- | Adds a button with the given text (or a stock button, if @buttonText@ is 233-- a stock ID) and sets things up so that clicking the button will emit the 234-- \"response\" signal with the given @responseId@. The button is appended to 235-- the end of the dialog's action area. The button widget is returned, but 236-- usually you don't need it. 237-- 238dialogAddButton :: (DialogClass self, GlibString string) => self 239 -> string -- ^ @buttonText@ - text of button, or stock ID 240 -> ResponseId -- ^ @responseId@ - response ID for the button 241 -> IO Button -- ^ returns the button widget that was added 242dialogAddButton self buttonText responseId = 243 makeNewObject mkButton $ liftM castPtr $ 244 withUTFString buttonText $ \buttonTextPtr -> 245 {# call dialog_add_button #} 246 (toDialog self) 247 buttonTextPtr 248 (fromResponse responseId) 249 250-- | Adds an activatable widget to the action area of a 'Dialog', connecting a 251-- signal handler that will emit the \"response\" signal on the dialog when the 252-- widget is activated. The widget is appended to the end of the dialog's 253-- action area. If you want to add a non-activatable widget, simply pack it 254-- into the action area. 255-- 256dialogAddActionWidget :: (DialogClass self, WidgetClass child) => self 257 -> child -- ^ @child@ - an activatable widget 258 -> ResponseId -- ^ @responseId@ - response ID for @child@ 259 -> IO () 260dialogAddActionWidget self child responseId = 261 {# call dialog_add_action_widget #} 262 (toDialog self) 263 (toWidget child) 264 (fromResponse responseId) 265 266#if GTK_MAJOR_VERSION < 3 267-- | Query if the dialog has a visible horizontal separator. 268-- 269-- Removed in Gtk3. 270dialogGetHasSeparator :: DialogClass self => self -> IO Bool 271dialogGetHasSeparator self = 272 liftM toBool $ 273 {# call unsafe dialog_get_has_separator #} 274 (toDialog self) 275 276-- | Sets whether the dialog has a separator above the buttons. @True@ by 277-- default. 278-- 279-- Removed in Gtk3. 280dialogSetHasSeparator :: DialogClass self => self -> Bool -> IO () 281dialogSetHasSeparator self setting = 282 {# call dialog_set_has_separator #} 283 (toDialog self) 284 (fromBool setting) 285#endif 286 287-- | Sets the last widget in the dialog's action area with the given 288-- 'ResponseId' as the default widget for the dialog. Pressing \"Enter\" 289-- normally activates the default widget. 290-- 291-- * The default response is reset once it is triggered. Hence, if you 292-- hide the dialog (rather than closing it) and re-display it later, 293-- you need to call this function again. 294-- 295dialogSetDefaultResponse :: DialogClass self => self 296 -> ResponseId 297 -> IO () 298dialogSetDefaultResponse self responseId = 299 {# call dialog_set_default_response #} 300 (toDialog self) 301 (fromResponse responseId) 302 303-- | Calls @'widgetSetSensitive' widget setting@ for each widget in the 304-- dialog's action area with the given @responseId@. A convenient way to 305-- sensitize\/desensitize dialog buttons. 306-- 307dialogSetResponseSensitive :: DialogClass self => self 308 -> ResponseId -- ^ @responseId@ - a response ID 309 -> Bool -- ^ @setting@ - @True@ for sensitive 310 -> IO () 311dialogSetResponseSensitive self responseId setting = 312 {# call dialog_set_response_sensitive #} 313 (toDialog self) 314 (fromResponse responseId) 315 (fromBool setting) 316 317-- | Gets the response id of a widget in the action area of a dialog. 318dialogGetResponseForWidget :: (DialogClass self, WidgetClass widget) => self 319 -> widget -- ^ @widget@ - a widget in the action area of dialog 320 -> IO ResponseId -- ^ return the response id of widget, or 'ResponseNone' if widget doesn't have a response id set. 321dialogGetResponseForWidget self widget = liftM toResponse $ 322 {# call dialog_get_response_for_widget #} 323 (toDialog self) 324 (toWidget widget) 325 326-- | Returns @True@ if dialogs are expected to use an alternative button order on the screen screen. 327-- See 'dialogSetAlternativeButtonOrder' for more details about alternative button order. 328-- 329-- If you need to use this function, you should probably connect to the 'alternativeButtonOrder' signal on the GtkSettings object associated to screen, in order to be notified if the button order setting changes. 330-- 331-- * Available since Gtk+ version 2.6 332-- 333dialogAlternativeDialogButtonOrder :: 334 Maybe Screen -- ^ @screen@ - a 'Screen', or @Nothing@ to use the default screen 335 -> IO Bool -- ^ returns whether the alternative button order should be used 336dialogAlternativeDialogButtonOrder (Just screen) = liftM toBool $ 337 {# call alternative_dialog_button_order #} screen 338dialogAlternativeDialogButtonOrder Nothing = liftM toBool $ 339 {# call alternative_dialog_button_order #} (Screen nullForeignPtr) 340 341-- | Sets an alternative button order. 342-- 343-- If the 'alternativeButtonOrder' setting is set to @True@, the dialog 344-- buttons are reordered according to the order of the response ids in 345-- @newOrder@. 346-- 347-- See 'dialogSetAlternativeButtonOrder' for more information. 348-- 349-- This function is for use by language bindings. 350-- 351-- * Available since Gtk+ version 2.6 352-- 353dialogSetAlternativeButtonOrderFromArray :: DialogClass self => self 354 -> [ResponseId] -- ^ @newOrder@ - an array of response ids of dialog's buttons 355 -> IO () 356dialogSetAlternativeButtonOrderFromArray self newOrder = 357 withArray (map fromResponse newOrder) $ \newOrderPtr -> 358 {# call dialog_set_alternative_button_order_from_array #} 359 (toDialog self) 360 (fromIntegral (length newOrder)) 361 newOrderPtr 362 363#if GTK_CHECK_VERSION(2,20,0) 364-- | Gets the widget button that uses the given response ID in the action area of a dialog. 365dialogGetWidgetForResponse :: DialogClass self => self 366 -> ResponseId -- ^ @responseId@ the response ID used by the dialog widget 367 -> IO (Maybe Widget) -- ^ returns the widget button that uses the given @responseId@, or 'Nothing'. 368dialogGetWidgetForResponse self responseId = 369 maybeNull (makeNewObject mkWidget) $ 370 {#call gtk_dialog_get_widget_for_response #} 371 (toDialog self) 372 (fromResponse responseId) 373#endif 374 375#if GTK_MAJOR_VERSION >= 3 376-- | Returns the content area of dialog. 377dialogGetContentArea :: DialogClass self => self -> IO Widget 378dialogGetContentArea self = 379 makeNewObject mkWidget $ 380 {#call gtk_dialog_get_content_area #} 381 (toDialog self) 382 383-- | Returns the action area of dialog. 384-- 385-- * This is useful to add some special widgets that cannot be added with 386-- dialogAddActionWidget. 387-- 388dialogGetActionArea :: DialogClass self => self -> IO Widget 389dialogGetActionArea self = 390 makeNewObject mkWidget $ 391 {#call gtk_dialog_get_content_area #} 392 (toDialog self) 393#else 394dialogGetContentArea self = liftM toWidget $ dialogGetUpper self 395#endif 396 397-------------------- 398-- Attributes 399#if GTK_MAJOR_VERSION < 3 400-- | The dialog has a separator bar above its buttons. 401-- 402-- Default value: @True@ 403-- 404-- Removed in Gtk3. 405dialogHasSeparator :: DialogClass self => Attr self Bool 406dialogHasSeparator = newAttr 407 dialogGetHasSeparator 408 dialogSetHasSeparator 409#endif 410 411-- | Width of border around the button area at the bottom of the dialog. 412-- 413-- Allowed values: >= 0 414-- 415-- Default value: 5 416-- 417dialogActionAreaBorder :: DialogClass self => ReadAttr self Int 418dialogActionAreaBorder = readAttrFromIntProperty "action-area-border" 419 420-- | Spacing between buttons. 421-- 422-- Allowed values: >= 0 423-- 424-- Default value: 6 425-- 426dialogButtonSpacing :: DialogClass self => ReadAttr self Int 427dialogButtonSpacing = readAttrFromIntProperty "button-spacing" 428 429-- | Width of border around the main dialog area. 430-- 431-- Allowed values: >= 0 432-- 433-- Default value: 2 434-- 435dialogContentAreaBorder :: DialogClass self => ReadAttr self Int 436dialogContentAreaBorder = readAttrFromIntProperty "content-area-border" 437 438-- | The default spacing used between elements of the content area of the dialog, 439-- as returned by 'dialogSetContentArea', unless 'boxSetSpacing' was called on that widget directly. 440-- 441-- Allowed values: >= 0 442-- 443-- Default value: 0 444-- 445-- * Available since Gtk+ version 2.16 446-- 447dialogContentAreaSpacing :: DialogClass self => ReadAttr self Int 448dialogContentAreaSpacing = readAttrFromIntProperty "content-area-spacing" 449 450-------------------- 451-- Signals 452 453-- | Emitted when an action widget is clicked, the dialog receives a delete 454-- event, or the application programmer calls 'dialogResponse'. On a delete 455-- event, the response ID is 'ResponseNone'. Otherwise, it depends on which 456-- action widget was clicked. 457-- 458response :: DialogClass self => Signal self (ResponseId -> IO ()) 459response = Signal (\after obj fun -> 460 connect_INT__NONE "response" after obj (\i -> fun (toResponse i))) 461 462-- * Deprecated 463#ifndef DISABLE_DEPRECATED 464-- | Emitted when an action widget is clicked, the dialog receives a delete 465-- event, or the application programmer calls 'dialogResponse'. On a delete 466-- event, the response ID is 'ResponseNone'. Otherwise, it depends on which 467-- action widget was clicked. 468-- 469onResponse, afterResponse :: DialogClass self => self 470 -> (ResponseId -> IO ()) 471 -> IO (ConnectId self) 472onResponse dia act = connect_INT__NONE "response" False dia (act . toResponse) 473afterResponse dia act = connect_INT__NONE "response" True dia (act . toResponse) 474#endif 475 476