hasufell/hsfm
1
1
Fork 0
Code Issues 33 Pull Requests Releases Wiki Activity

GTK: improve error dialog system

Browse Source
This commit is contained in:
Julian Ospald 2015-12-22 17:56:37 +01:00
parent 6a9d408925
commit 0b41fee237
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/GUI/Gtk/Callbacks.hs
View File

@ -105,20 +105,20 @@ urlGoTo mygui myview = do
-- |Supposed to be used with 'withRow'. Opens a file or directory. -- |Supposed to be used with 'withRow'. Opens a file or directory.
open :: Row -> MyGUI -> MyView -> IO () open :: Row -> MyGUI -> MyView -> IO ()
open row mygui myview = open row mygui myview = withErrorDialog $
case row of case row of
r@(_ :/ Dir _ _) -> do r@(_ :/ Dir _ _) -> do
nv <- Data.DirTree.readFile $ fullPath r nv <- Data.DirTree.readFile $ fullPath r
refreshTreeView' mygui myview nv refreshTreeView' mygui myview nv
r -> r ->
withErrorDialog $ openFile r void $ openFile r
-- |Supposed to be used with 'withRow'. Deletes a file or directory. -- |Supposed to be used with 'withRow'. Deletes a file or directory.
del :: Row -> MyGUI -> MyView -> IO () del :: Row -> MyGUI -> MyView -> IO ()
del row mygui myview = do del row mygui myview = withErrorDialog $ do
let cmsg = "Really delete \"" ++ fullPath row ++ "\"?" let cmsg = "Really delete \"" ++ fullPath row ++ "\"?"
withConfirmationDialog cmsg . withErrorDialog withConfirmationDialog cmsg
$ easyDelete row >> refreshTreeView mygui myview Nothing $ easyDelete row >> refreshTreeView mygui myview Nothing
@ -138,7 +138,7 @@ copyInit row mygui myview =
-- --
-- * 'operationBuffer' reads -- * 'operationBuffer' reads
copyFinal :: MyGUI -> MyView -> IO () copyFinal :: MyGUI -> MyView -> IO ()
copyFinal mygui myview = do copyFinal mygui myview = withErrorDialog $ do
op <- readTVarIO (operationBuffer myview) op <- readTVarIO (operationBuffer myview)
mcdir <- getFirstRow myview mcdir <- getFirstRow myview
case op of case op of
@ -146,8 +146,8 @@ copyFinal mygui myview = do
dest <- goUp mcdir dest <- goUp mcdir
let cmsg = "Really copy \"" ++ fullPath s let cmsg = "Really copy \"" ++ fullPath s
++ "\"" ++ " to \"" ++ fullPath dest ++ "\"?" ++ "\"" ++ " to \"" ++ fullPath dest ++ "\"?"
withConfirmationDialog cmsg . withErrorDialog withConfirmationDialog cmsg
$ (runFileOp (FCopy . CC s dest $ Strict) (runFileOp (FCopy . CC s dest $ Strict)
>> refreshTreeView mygui myview Nothing) >> refreshTreeView mygui myview Nothing)
return () return ()
_ -> return () _ -> return ()
@ -160,7 +160,7 @@ copyFinal mygui myview = do
-- * 'rawModel' reads -- * 'rawModel' reads
-- * 'sortedModel' reads -- * 'sortedModel' reads
upDir :: MyGUI -> MyView -> IO () upDir :: MyGUI -> MyView -> IO ()
upDir mygui myview = do upDir mygui myview = withErrorDialog $ do
mcdir <- getFirstRow myview mcdir <- getFirstRow myview
rawModel' <- readTVarIO $ rawModel myview rawModel' <- readTVarIO $ rawModel myview
sortedModel' <- readTVarIO $ sortedModel myview sortedModel' <- readTVarIO $ sortedModel myview