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

GUI: allow deletion of non-empty directories

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

10
src/GUI/Gtk/Gui.hs
View File

@ -236,12 +236,16 @@ open row mygui myview = case row of
-- |Supposed to be used with `withRow`. Deletes a file or directory. -- |Supposed to be used with `withRow`. Deletes a file or directory.
del :: DTInfoZipper -> MyGUI -> MyView -> IO () del :: DTInfoZipper -> MyGUI -> MyView -> IO ()
del row mygui myview = case row of del row mygui myview = case row of
dz@(Dir {}, _) -> do dz@(Dir _ cs _, _) -> do
let fp = getFullPath dz let fp = getFullPath dz
cmsg = "Really delete directory \"" ++ fp ++ "\"?" cmsg = "Really delete directory \"" ++ fp ++ "\"?"
withConfirmationDialog cmsg cmsg2 = "Directory \"" ++ fp ++ "\" is not empty! Delete all contents?"
$ withErrorDialog (deleteDir dz withConfirmationDialog cmsg $
if null cs
then withErrorDialog (deleteDir dz
>> refreshTreeView mygui myview Nothing) >> refreshTreeView mygui myview Nothing)
else withConfirmationDialog cmsg2 $ withErrorDialog
(deleteDirRecursive dz >> refreshTreeView mygui myview Nothing)
dz@(File {}, _) -> do dz@(File {}, _) -> do
let fp = getFullPath dz let fp = getFullPath dz
cmsg = "Really delete file \"" ++ fp ++ "\"?" cmsg = "Really delete file \"" ++ fp ++ "\"?"