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