diff --git a/src/app/MetaBrush/Action.hs b/src/app/MetaBrush/Action.hs index dc16f86..87d6b80 100644 --- a/src/app/MetaBrush/Action.hs +++ b/src/app/MetaBrush/Action.hs @@ -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