mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
UI: use GTK Window instead of MessageDialog
This commit is contained in:
sheaf
parent
fc2f25cfa6
commit
e2e4ae6bfe
|
|
@ -1,5 +1,7 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
module MetaBrush.Action where
|
module MetaBrush.Action where
|
||||||
|
|
||||||
-- base
|
-- base
|
||||||
|
|
@ -9,8 +11,6 @@ import Control.Monad.ST
|
||||||
( RealWorld )
|
( RealWorld )
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
( for_ )
|
( for_ )
|
||||||
import Data.Int
|
|
||||||
( Int32 )
|
|
||||||
import Data.List
|
import Data.List
|
||||||
( uncons )
|
( uncons )
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
@ -231,32 +231,47 @@ instance HandleAction OpenFile where
|
||||||
for_ fileNames $ \ filePath -> do
|
for_ fileNames $ \ filePath -> do
|
||||||
mbDoc <- loadDocument uniqueSupply filePath
|
mbDoc <- loadDocument uniqueSupply filePath
|
||||||
case mbDoc of
|
case mbDoc of
|
||||||
Left errMessage -> warningDialog window filePath errMessage
|
Left errMessage -> openFileWarningDialog window filePath errMessage
|
||||||
Right doc -> do
|
Right doc -> do
|
||||||
let newDocHist = newHistory doc
|
let newDocHist = newHistory doc
|
||||||
newFileTab uiElts vars (Just newDocHist) tabLoc
|
newFileTab uiElts vars (Just newDocHist) tabLoc
|
||||||
updateHistoryState uiElts (Just newDocHist)
|
updateHistoryState uiElts (Just newDocHist)
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
warningDialog
|
openFileWarningDialog
|
||||||
:: ( Show errMess, GTK.IsWindow window )
|
:: GTK.IsWindow window
|
||||||
=> window -> FilePath -> errMess -> IO ()
|
=> window -> FilePath -> String -> IO ()
|
||||||
warningDialog window filePath errMess = do
|
openFileWarningDialog window filePath errMess = do
|
||||||
-- GTK 4 TODO: use Window
|
|
||||||
dialog <- GTK.new GTK.MessageDialog []
|
dialogWindow <- GTK.windowNew
|
||||||
GTK.setMessageDialogText dialog
|
GTK.setWindowDecorated dialogWindow False
|
||||||
( "Could not load file at " <> Text.pack filePath <> ":\n" <> Text.pack ( show errMess ) )
|
GTK.windowSetTransientFor dialogWindow (Just window)
|
||||||
GTK.setMessageDialogMessageType dialog GTK.MessageTypeWarning
|
|
||||||
GTK.setWindowResizable dialog True
|
contentBox <- GTK.boxNew GTK.OrientationVertical 30
|
||||||
GTK.setWindowDecorated dialog False
|
GTK.widgetSetMarginStart contentBox 20
|
||||||
GTK.windowSetTransientFor dialog ( Just window )
|
GTK.widgetSetMarginEnd contentBox 20
|
||||||
GTK.windowSetModal dialog True
|
GTK.widgetSetMarginTop contentBox 20
|
||||||
widgetAddClasses dialog [ "metabrush", "bg", "plain", "text", "dialog" ]
|
GTK.widgetSetMarginBottom contentBox 20
|
||||||
closeButton <- GTK.dialogAddButton dialog "OK" 1
|
|
||||||
|
label <- GTK.labelNew $ Just $ "Could not load file at " <> Text.pack filePath <> ":\n" <> Text.pack errMess
|
||||||
|
GTK.boxAppend contentBox label
|
||||||
|
|
||||||
|
closeButton <- GTK.buttonNew
|
||||||
|
GTK.buttonSetLabel closeButton "OK"
|
||||||
|
GTK.boxAppend contentBox closeButton
|
||||||
|
|
||||||
|
GTK.windowSetChild dialogWindow (Just contentBox)
|
||||||
|
|
||||||
|
widgetAddClasses dialogWindow ["metabrush", "bg", "plain", "text", "dialog"]
|
||||||
widgetAddClass closeButton "dialogButton"
|
widgetAddClass closeButton "dialogButton"
|
||||||
widgetShow dialog
|
|
||||||
void $ GTK.afterDialogResponse dialog \ _ -> do
|
void $ GTK.onButtonClicked closeButton $ do
|
||||||
GTK.windowDestroy dialog
|
GTK.windowDestroy dialogWindow
|
||||||
|
|
||||||
|
GTK.widgetSetVisible dialogWindow True
|
||||||
|
|
||||||
|
-- TODO: make the dialog draggable.
|
||||||
|
-- See https://discourse.gnome.org/t/enabling-window-dragging-on-specific-elements-in-gtk-4/5731/4
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
-- Open folder --
|
-- Open folder --
|
||||||
|
|
@ -286,7 +301,7 @@ instance HandleAction OpenFolder where
|
||||||
for_ filePaths \ filePath -> when ( takeExtension filePath == ".mb" ) do
|
for_ filePaths \ filePath -> when ( takeExtension filePath == ".mb" ) do
|
||||||
mbDoc <- loadDocument uniqueSupply ( folderPath </> filePath )
|
mbDoc <- loadDocument uniqueSupply ( folderPath </> filePath )
|
||||||
case mbDoc of
|
case mbDoc of
|
||||||
Left errMessage -> warningDialog window filePath errMessage
|
Left errMessage -> openFileWarningDialog window filePath errMessage
|
||||||
Right doc -> do
|
Right doc -> do
|
||||||
let
|
let
|
||||||
newDocHist :: DocumentHistory
|
newDocHist :: DocumentHistory
|
||||||
|
|
@ -414,11 +429,6 @@ data Close
|
||||||
{ docToClose :: !Unique }
|
{ docToClose :: !Unique }
|
||||||
deriving stock Show
|
deriving stock Show
|
||||||
|
|
||||||
pattern JustClose, SaveAndClose, CancelClose :: Int32
|
|
||||||
pattern JustClose = 1
|
|
||||||
pattern SaveAndClose = 2
|
|
||||||
pattern CancelClose = 3
|
|
||||||
|
|
||||||
instance HandleAction Close where
|
instance HandleAction Close where
|
||||||
handleAction
|
handleAction
|
||||||
uiElts@( UIElements {..} )
|
uiElts@( UIElements {..} )
|
||||||
|
|
@ -436,28 +446,49 @@ instance HandleAction Close where
|
||||||
Just ( Document { displayName, documentUnique, documentContent }, isActiveDoc )
|
Just ( Document { displayName, documentUnique, documentContent }, isActiveDoc )
|
||||||
| unsavedChanges documentContent
|
| unsavedChanges documentContent
|
||||||
-> do
|
-> do
|
||||||
-- GTK 4 TODO: use Window
|
dialogWindow <- GTK.windowNew
|
||||||
dialog <- GTK.new GTK.MessageDialog []
|
GTK.setWindowDecorated dialogWindow False
|
||||||
GTK.setMessageDialogText dialog ( " \n\"" <> displayName <> "\" contains unsaved changes.\nClose anyway?" )
|
GTK.windowSetTransientFor dialogWindow (Just window)
|
||||||
GTK.setMessageDialogMessageType dialog GTK.MessageTypeQuestion
|
|
||||||
GTK.setWindowResizable dialog False
|
contentBox <- GTK.boxNew GTK.OrientationVertical 30
|
||||||
GTK.setWindowDecorated dialog False
|
GTK.widgetSetMarginStart contentBox 20
|
||||||
GTK.windowSetTransientFor dialog ( Just window )
|
GTK.widgetSetMarginEnd contentBox 20
|
||||||
GTK.windowSetModal dialog True
|
GTK.widgetSetMarginTop contentBox 20
|
||||||
widgetAddClasses dialog [ "metabrush", "bg", "plain", "text", "dialog" ]
|
GTK.widgetSetMarginBottom contentBox 20
|
||||||
closeButton <- GTK.dialogAddButton dialog "Close" JustClose
|
GTK.windowSetChild dialogWindow (Just contentBox)
|
||||||
saveButton <- GTK.dialogAddButton dialog "Save and close" SaveAndClose
|
|
||||||
cancelButton <- GTK.dialogAddButton dialog "Cancel" CancelClose
|
label <- GTK.labelNew $ Just $ "\n\"" <> displayName <> "\" contains unsaved changes.\nClose anyway?"
|
||||||
GTK.dialogSetDefaultResponse dialog JustClose
|
GTK.boxAppend contentBox label
|
||||||
for_ [ closeButton, saveButton, cancelButton ]
|
|
||||||
( `widgetAddClass` "dialogButton" )
|
buttonBox <- GTK.boxNew GTK.OrientationHorizontal 0
|
||||||
widgetShow dialog
|
|
||||||
void $ GTK.onDialogResponse dialog \ choice -> do
|
GTK.boxAppend contentBox buttonBox
|
||||||
case choice of
|
|
||||||
JustClose -> closeDocument isActiveDoc documentUnique
|
closeButton <- GTK.buttonNew
|
||||||
SaveAndClose -> save uiElts vars False
|
GTK.buttonSetLabel closeButton "Close"
|
||||||
_ -> pure ()
|
GTK.boxAppend buttonBox closeButton
|
||||||
GTK.windowDestroy dialog
|
saveCloseButton <- GTK.buttonNew
|
||||||
|
GTK.buttonSetLabel saveCloseButton "Save and close"
|
||||||
|
GTK.boxAppend buttonBox saveCloseButton
|
||||||
|
cancelButton <- GTK.buttonNew
|
||||||
|
GTK.buttonSetLabel cancelButton "Cancel"
|
||||||
|
GTK.boxAppend buttonBox cancelButton
|
||||||
|
|
||||||
|
widgetAddClasses dialogWindow ["metabrush", "bg", "plain", "text", "dialog"]
|
||||||
|
for_ [closeButton, saveCloseButton, cancelButton] \ button ->
|
||||||
|
widgetAddClass button "dialogButton"
|
||||||
|
|
||||||
|
void $ GTK.onButtonClicked closeButton $ do
|
||||||
|
closeDocument isActiveDoc documentUnique
|
||||||
|
GTK.windowDestroy dialogWindow
|
||||||
|
void $ GTK.onButtonClicked saveCloseButton $ do
|
||||||
|
save uiElts vars False
|
||||||
|
GTK.windowDestroy dialogWindow
|
||||||
|
void $ GTK.onButtonClicked cancelButton $ do
|
||||||
|
GTK.windowDestroy dialogWindow
|
||||||
|
|
||||||
|
GTK.widgetSetVisible dialogWindow True
|
||||||
|
|
||||||
| otherwise
|
| otherwise
|
||||||
-> closeDocument isActiveDoc documentUnique
|
-> closeDocument isActiveDoc documentUnique
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue