mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
UI: use GTK4 FileDialog API
This commit is contained in:
sheaf
parent
bb9b381cb5
commit
fc2f25cfa6
|
|
@ -203,38 +203,40 @@ data OpenFile = OpenFile !TabLocation
|
|||
|
||||
instance HandleAction OpenFile where
|
||||
handleAction uiElts@( UIElements {..} ) vars@( Variables {..} ) ( OpenFile tabLoc ) = do
|
||||
-- GTK 4 TODO: use FileDialog
|
||||
fileChooser <-
|
||||
GTK.fileChooserNativeNew ( Just "Open MetaBrush document..." ) ( Just window )
|
||||
GTK.FileChooserActionOpen
|
||||
( Just "Open" )
|
||||
( Just "Cancel" )
|
||||
GTK.fileChooserSetSelectMultiple fileChooser True
|
||||
GTK.fileChooserSetAction fileChooser GTK.FileChooserActionOpen
|
||||
GTK.nativeDialogSetModal fileChooser True
|
||||
fileDialog <- GTK.fileDialogNew
|
||||
GTK.fileDialogSetTitle fileDialog "Open MetaBrush document..."
|
||||
GTK.fileDialogSetModal fileDialog True
|
||||
GTK.fileDialogSetAcceptLabel fileDialog (Just "Open")
|
||||
|
||||
fileFilter <- GTK.fileFilterNew
|
||||
GTK.fileFilterSetName fileFilter ( Just "MetaBrush document" )
|
||||
GTK.fileFilterSetName fileFilter (Just "MetaBrush document")
|
||||
GTK.fileFilterAddPattern fileFilter "*.mb"
|
||||
GTK.fileChooserAddFilter fileChooser fileFilter
|
||||
GTK.nativeDialogShow fileChooser
|
||||
void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
|
||||
when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
|
||||
files <- GTK.fileChooserGetFiles fileChooser
|
||||
nbFiles <- GIO.listModelGetNItems files
|
||||
fileNames <- catMaybes <$>
|
||||
for [ ( 0 :: Int ) .. fromIntegral nbFiles - 1 ] \ i ->
|
||||
GIO.listModelGetItem files ( fromIntegral i ) >>?=
|
||||
( GI.castTo GIO.File >=?=> GIO.fileGetPath )
|
||||
for_ fileNames \ filePath -> do
|
||||
mbDoc <- loadDocument uniqueSupply filePath
|
||||
case mbDoc of
|
||||
Left errMessage -> warningDialog window filePath errMessage
|
||||
Right doc -> do
|
||||
let
|
||||
newDocHist :: DocumentHistory
|
||||
newDocHist = newHistory doc
|
||||
newFileTab uiElts vars ( Just newDocHist ) tabLoc
|
||||
updateHistoryState uiElts ( Just newDocHist )
|
||||
GTK.setFileDialogDefaultFilter fileDialog fileFilter
|
||||
fileFilterType <- GTK.gvalueGType_ @(Maybe GTK.FileFilter)
|
||||
filterList <- GIO.listStoreNew fileFilterType
|
||||
void $ GIO.listStoreAppend filterList fileFilter
|
||||
GTK.fileDialogSetFilters fileDialog (Just filterList)
|
||||
|
||||
GTK.fileDialogOpenMultiple fileDialog (Just window) (Nothing :: Maybe GIO.Cancellable) $
|
||||
Just $ \ _ result -> do
|
||||
response <- GTK.handleDialogError (\ _ _ -> return Nothing) $
|
||||
GTK.fileDialogOpenMultipleFinish fileDialog result
|
||||
case response of
|
||||
Just files -> do
|
||||
nbFiles <- GIO.listModelGetNItems files
|
||||
fileNames <- catMaybes <$>
|
||||
for [ ( 0 :: Int ) .. fromIntegral nbFiles - 1 ] \ i ->
|
||||
GIO.listModelGetItem files ( fromIntegral i ) >>?=
|
||||
( GI.castTo GIO.File >=?=> GIO.fileGetPath )
|
||||
for_ fileNames $ \ filePath -> do
|
||||
mbDoc <- loadDocument uniqueSupply filePath
|
||||
case mbDoc of
|
||||
Left errMessage -> warningDialog window filePath errMessage
|
||||
Right doc -> do
|
||||
let newDocHist = newHistory doc
|
||||
newFileTab uiElts vars (Just newDocHist) tabLoc
|
||||
updateHistoryState uiElts (Just newDocHist)
|
||||
Nothing -> return ()
|
||||
|
||||
warningDialog
|
||||
:: ( Show errMess, GTK.IsWindow window )
|
||||
|
|
@ -265,18 +267,16 @@ data OpenFolder = OpenFolder !TabLocation
|
|||
|
||||
instance HandleAction OpenFolder where
|
||||
handleAction uiElts@( UIElements {..} ) vars@( Variables {..} ) ( OpenFolder tabLoc ) = do
|
||||
-- GTK 4 TODO: use FileDialog
|
||||
fileChooser <-
|
||||
GTK.fileChooserNativeNew ( Just "Select folder..." ) ( Just window )
|
||||
GTK.FileChooserActionSelectFolder
|
||||
( Just "Select Folder" )
|
||||
( Just "Cancel" )
|
||||
GTK.fileChooserSetAction fileChooser GTK.FileChooserActionSelectFolder
|
||||
GTK.nativeDialogSetModal fileChooser True
|
||||
GTK.nativeDialogShow fileChooser
|
||||
void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
|
||||
when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
|
||||
mbFolder <- GTK.fileChooserGetFile fileChooser
|
||||
|
||||
fileDialog <- GTK.fileDialogNew
|
||||
GTK.fileDialogSetTitle fileDialog "Select folder..."
|
||||
GTK.fileDialogSetModal fileDialog True
|
||||
GTK.fileDialogSetAcceptLabel fileDialog (Just "Open")
|
||||
|
||||
GTK.fileDialogSelectFolder fileDialog (Just window) (Nothing :: Maybe GIO.Cancellable) $
|
||||
Just $ \ _ result -> do
|
||||
mbFolder <- GTK.handleDialogError (\ _ _ -> return Nothing) $
|
||||
GTK.fileDialogSelectFolderFinish fileDialog result
|
||||
for_ mbFolder \ folder -> do
|
||||
mbFolderPath <- GIO.fileGetPath folder
|
||||
for_ mbFolderPath \ folderPath -> do
|
||||
|
|
@ -364,23 +364,26 @@ export uiElts vars@( Variables { .. } ) = do
|
|||
|
||||
withSavePath :: UIElements -> SaveFormat -> ( FilePath -> IO () ) -> IO ()
|
||||
withSavePath ( UIElements {..} ) saveFormat action = do
|
||||
-- GTK 4 TODO: use FileDialog
|
||||
fileChooser <-
|
||||
GTK.fileChooserNativeNew ( Just saveText ) ( Just window )
|
||||
GTK.FileChooserActionSave
|
||||
( Just saveOrExport )
|
||||
( Just "Cancel" )
|
||||
GTK.nativeDialogSetModal fileChooser True
|
||||
GTK.fileChooserSetAction fileChooser GTK.FileChooserActionSave
|
||||
fileDialog <- GTK.fileDialogNew
|
||||
GTK.fileDialogSetTitle fileDialog saveText
|
||||
GTK.fileDialogSetModal fileDialog True
|
||||
GTK.fileDialogSetAcceptLabel fileDialog (Just "Open")
|
||||
|
||||
fileFilter <- GTK.fileFilterNew
|
||||
GTK.fileFilterSetName fileFilter ( Just $ Text.pack $ show saveFormat <> " document" )
|
||||
GTK.fileFilterSetName fileFilter (Just $ Text.pack $ show saveFormat <> " document")
|
||||
|
||||
GTK.fileFilterAddPattern fileFilter ( "*." <> extension )
|
||||
GTK.fileChooserAddFilter fileChooser fileFilter
|
||||
GTK.nativeDialogShow fileChooser
|
||||
void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
|
||||
when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
|
||||
mbSaveFile <- GTK.fileChooserGetFile fileChooser
|
||||
for_ mbSaveFile \ saveFile -> do
|
||||
GTK.setFileDialogDefaultFilter fileDialog fileFilter
|
||||
fileFilterType <- GTK.gvalueGType_ @(Maybe GTK.FileFilter)
|
||||
filterList <- GIO.listStoreNew fileFilterType
|
||||
void $ GIO.listStoreAppend filterList fileFilter
|
||||
GTK.fileDialogSetFilters fileDialog (Just filterList)
|
||||
|
||||
GTK.fileDialogSave fileDialog (Just window) (Nothing :: Maybe GIO.Cancellable) $
|
||||
Just $ \ _ result -> do
|
||||
mbSaveFile <- GTK.handleDialogError (\ _ _ -> return Nothing) $
|
||||
GTK.fileDialogSaveFinish fileDialog result
|
||||
for_ mbSaveFile $ \ saveFile -> do
|
||||
mbSavePath <- fmap fullFilePath <$> GIO.fileGetPath saveFile
|
||||
for_ mbSavePath action
|
||||
where
|
||||
|
|
|
|||
Loading…
Reference in a new issue