4
import Graphics.UI.Gtk.Glade
10
-- load up our main window
11
dialogXmlM <- xmlNew "FileChooserDemo.glade"
12
let dialogXml = case dialogXmlM of
13
(Just dialogXml) -> dialogXml
14
Nothing -> error $ "can't find the glade file \"FileChooserDemo.glade\""
15
++ "in the current directory"
17
-- get a handle on a various objects from the glade file
18
mainWindow <- xmlGetWidget dialogXml castToWindow "mainWindow"
19
mainWindow `onDestroy` mainQuit
21
-- and associate actions with the buttons
22
selectFolderButton <- xmlGetWidget dialogXml castToButton "selectFolderButton"
23
selectFolderButton `onClicked` openSelectFolderDialog mainWindow
25
createFolderButton <- xmlGetWidget dialogXml castToButton "createFolderButton"
26
createFolderButton `onClicked` openCreateFolderDialog mainWindow
28
openFileButton <- xmlGetWidget dialogXml castToButton "openFileButton"
29
openFileButton `onClicked` openOpenFileDialog mainWindow
31
saveFileButton <- xmlGetWidget dialogXml castToButton "saveFileButton"
32
saveFileButton `onClicked` openSaveFileDialog mainWindow
34
openFilePreviewButton <- xmlGetWidget dialogXml castToButton "openFilePreviewButton"
35
openFilePreviewButton `onClicked` openFilePreviewDialog mainWindow
37
quitButton <- xmlGetWidget dialogXml castToButton "quitButton"
38
quitButton `onClicked` mainQuit
40
-- The final step is to display the main window and run the main loop
41
widgetShowAll mainWindow
45
openSelectFolderDialog :: Window -> IO ()
46
openSelectFolderDialog parentWindow = do
47
dialog <- fileChooserDialogNew
48
(Just $ "Demo of the standard dialog "
49
++ "to select an existing folder") --dialog title
50
(Just parentWindow) --the parent window
51
FileChooserActionSelectFolder --the kind of dialog we want
52
[("Yes, this new dialog looks nice" --The buttons to display
54
,("Eugh! Take me away!"
57
response <- dialogRun dialog
59
ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
60
putStrLn $ "you selected the folder " ++ show fileName
61
ResponseCancel -> putStrLn "dialog canceled"
62
ResponseDeleteEvent -> putStrLn "dialog closed"
65
openCreateFolderDialog :: Window -> IO ()
66
openCreateFolderDialog parentWindow = do
67
dialog <- fileChooserDialogNew
68
(Just $ "Demo of the standard dialog to select "
69
++ "a new folder (or existing) folder") --dialog title
70
(Just parentWindow) --the parent window
71
FileChooserActionCreateFolder --the kind of dialog we want
72
[("I want this new folder" --The buttons to display
77
response <- dialogRun dialog
79
ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
80
putStrLn $ "you selected the folder " ++ show fileName
81
ResponseCancel -> putStrLn "Getting bored?"
82
ResponseDeleteEvent -> putStrLn "dialog closed"
85
openOpenFileDialog :: Window -> IO ()
86
openOpenFileDialog parentWindow = do
87
dialog <- fileChooserDialogNew
88
(Just $ "Demo of the standard dialog to select "
89
++ "an existing file") --dialog title
90
(Just parentWindow) --the parent window
91
FileChooserActionOpen --the kind of dialog we want
92
[("gtk-cancel" --The buttons to display
98
response <- dialogRun dialog
100
ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
101
putStrLn $ "you selected the file " ++ show fileName
102
ResponseCancel -> putStrLn "dialog canceled"
103
ResponseDeleteEvent -> putStrLn "dialog closed"
106
openSaveFileDialog :: Window -> IO ()
107
openSaveFileDialog parentWindow = do
108
dialog <- fileChooserDialogNew
109
(Just $ "Demo of the standard dialog to select "
110
++ "a new file") --dialog title
111
(Just parentWindow) --the parent window
112
FileChooserActionSave --the kind of dialog we want
113
[("gtk-cancel" --The buttons to display
114
,ResponseCancel) --you can use stock buttons
118
response <- dialogRun dialog
120
ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
121
putStrLn $ "you called the new file " ++ show fileName
122
ResponseCancel -> putStrLn "dialog canceled"
123
ResponseDeleteEvent -> putStrLn "dialog closed"
126
openFilePreviewDialog :: Window -> IO ()
127
openFilePreviewDialog parentWindow = do
128
dialog <- fileChooserDialogNew
129
(Just $ "Demo of the standard dialog to select "
130
++ "a new file - with a preview widget") --dialog title
131
(Just parentWindow) --the parent window
132
FileChooserActionOpen --the kind of dialog we want
133
[("_Yes, yes that's very clever" --The buttons to display
135
,("_No, I'm not impressed"
138
--create and set an extra widget
139
checkButton <- checkButtonNewWithLabel "frobnicate this file"
140
dialog `fileChooserSetExtraWidget` checkButton
142
--create and set a preview widget
143
previewLabel <- labelNew $ Just "Preview appears here"
144
previewLabel `labelSetLineWrap` True
145
dialog `fileChooserSetPreviewWidget` previewLabel
146
dialog `onUpdatePreview` do
147
previewFile <- fileChooserGetPreviewFilename dialog
148
previewLabel `labelSetText` case previewFile of
149
Nothing -> "Preview appears here"
150
(Just filename) -> "Just pretend this is a preview of the file:\n" ++
154
response <- dialogRun dialog
156
ResponseAccept -> do fileName <- fileChooserGetFilename dialog
157
putStrLn $ "you selected the new file " ++ show fileName
159
--check the state of the extra widget
160
frobnicate <- toggleButtonGetActive checkButton
161
putStrLn $ if frobnicate
162
then "you foolishly decided to frobnicate the file"
163
else "you wisely decided not to frobnicate the file"
164
ResponseCancel -> putStrLn "you were not impressed"
165
ResponseDeleteEvent -> putStrLn "dialog closed"
added
removed
demo/filechooser/FileChooserDemo.hs
