1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
module Main where
import Graphics.UI.Gtk hiding (response)
main :: IO ()
main = do
initGUI
-- load up our main window
gui <- builderNew
builderAddFromFile gui "FileChooserDemo.glade"
mainWindow <- builderGetObject gui castToWindow "mainWindow"
-- get a handle on a various objects from the glade file
on mainWindow objectDestroy mainQuit
let onClicked obj = on obj buttonActivated
-- -- and associate actions with the buttons
selectFolderButton <- builderGetObject gui castToButton "selectFolderButton"
selectFolderButton `onClicked` openSelectFolderDialog mainWindow
createFolderButton <- builderGetObject gui castToButton "createFolderButton"
createFolderButton `onClicked` openCreateFolderDialog mainWindow
openFileButton <- builderGetObject gui castToButton "openFileButton"
openFileButton `onClicked` openOpenFileDialog mainWindow
saveFileButton <- builderGetObject gui castToButton "saveFileButton"
saveFileButton `onClicked` openSaveFileDialog mainWindow
openFilePreviewButton <- builderGetObject gui castToButton "openFilePreviewButton"
openFilePreviewButton `onClicked` openFilePreviewDialog mainWindow
quitButton <- builderGetObject gui castToButton "quitButton"
quitButton `onClicked` (do
widgetDestroy mainWindow
mainQuit)
-- The final step is to display the main window and run the main loop
widgetShowAll mainWindow
mainGUI
openSelectFolderDialog :: Window -> IO ()
openSelectFolderDialog parentWindow = do
dialog <- fileChooserDialogNew
(Just $ "Demo of the standard dialog "
++ "to select an existing folder") --dialog title
(Just parentWindow) --the parent window
FileChooserActionSelectFolder --the kind of dialog we want
[("Yes, this new dialog looks nice" --The buttons to display
, ResponseAccept)
,("Eugh! Take me away!"
,ResponseCancel)]
widgetShow dialog
response <- dialogRun dialog
case response of
ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
putStrLn $ "you selected the folder " ++ show fileName
ResponseCancel -> putStrLn "dialog canceled"
ResponseDeleteEvent -> putStrLn "dialog closed"
widgetHide dialog
openCreateFolderDialog :: Window -> IO ()
openCreateFolderDialog parentWindow = do
dialog <- fileChooserDialogNew
(Just $ "Demo of the standard dialog to select "
++ "a new folder (or existing) folder") --dialog title
(Just parentWindow) --the parent window
FileChooserActionCreateFolder --the kind of dialog we want
[("I want this new folder" --The buttons to display
, ResponseAccept)
,("Bored now."
,ResponseCancel)]
widgetShow dialog
response <- dialogRun dialog
case response of
ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
putStrLn $ "you selected the folder " ++ show fileName
ResponseCancel -> putStrLn "Getting bored?"
ResponseDeleteEvent -> putStrLn "dialog closed"
widgetHide dialog
openOpenFileDialog :: Window -> IO ()
openOpenFileDialog parentWindow = do
dialog <- fileChooserDialogNew
(Just $ "Demo of the standard dialog to select "
++ "an existing file") --dialog title
(Just parentWindow) --the parent window
FileChooserActionOpen --the kind of dialog we want
[("gtk-cancel" --The buttons to display
,ResponseCancel)
,("gtk-open"
, ResponseAccept)]
widgetShow dialog
response <- dialogRun dialog
case response of
ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
putStrLn $ "you selected the file " ++ show fileName
ResponseCancel -> putStrLn "dialog canceled"
ResponseDeleteEvent -> putStrLn "dialog closed"
widgetHide dialog
openSaveFileDialog :: Window -> IO ()
openSaveFileDialog parentWindow = do
dialog <- fileChooserDialogNew
(Just $ "Demo of the standard dialog to select "
++ "a new file") --dialog title
(Just parentWindow) --the parent window
FileChooserActionSave --the kind of dialog we want
[("gtk-cancel" --The buttons to display
,ResponseCancel) --you can use stock buttons
,("gtk-save"
, ResponseAccept)]
widgetShow dialog
response <- dialogRun dialog
case response of
ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
putStrLn $ "you called the new file " ++ show fileName
ResponseCancel -> putStrLn "dialog canceled"
ResponseDeleteEvent -> putStrLn "dialog closed"
widgetHide dialog
openFilePreviewDialog :: Window -> IO ()
openFilePreviewDialog parentWindow = do
dialog <- fileChooserDialogNew
(Just $ "Demo of the standard dialog to select "
++ "a new file - with a preview widget") --dialog title
(Just parentWindow) --the parent window
FileChooserActionOpen --the kind of dialog we want
[("_Yes, yes that's very clever" --The buttons to display
, ResponseAccept)
,("_No, I'm not impressed"
,ResponseCancel)]
--create and set an extra widget
checkButton <- checkButtonNewWithLabel "frobnicate this file"
dialog `fileChooserSetExtraWidget` checkButton
--create and set a preview widget
previewLabel <- labelNew $ Just "Preview appears here"
previewLabel `labelSetLineWrap` True
dialog `fileChooserSetPreviewWidget` previewLabel
on dialog updatePreview $ do
previewFile <- fileChooserGetPreviewFilename dialog
previewLabel `labelSetText` case previewFile of
Nothing -> "Preview appears here"
(Just filename) -> "Just pretend this is a preview of the file:\n" ++
show filename
widgetShow dialog
response <- dialogRun dialog
case response of
ResponseAccept -> do fileName <- fileChooserGetFilename dialog
putStrLn $ "you selected the new file " ++ show fileName
--check the state of the extra widget
frobnicate <- toggleButtonGetActive checkButton
putStrLn $ if frobnicate
then "you foolishly decided to frobnicate the file"
else "you wisely decided not to frobnicate the file"
ResponseCancel -> putStrLn "you were not impressed"
ResponseDeleteEvent -> putStrLn "dialog closed"
widgetHide dialog
|
