GTK: implement file move callbacks
This commit is contained in:
parent
09821f8fc2
commit
4d2a4fd1fc
@ -85,10 +85,14 @@ setCallbacks mygui myview = do
|
|||||||
[Control] <- eventModifier
|
[Control] <- eventModifier
|
||||||
"c" <- fmap glibToString eventKeyName
|
"c" <- fmap glibToString eventKeyName
|
||||||
liftIO $ withRow mygui myview copyInit
|
liftIO $ withRow mygui myview copyInit
|
||||||
|
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
|
||||||
|
[Control] <- eventModifier
|
||||||
|
"x" <- fmap glibToString eventKeyName
|
||||||
|
liftIO $ withRow mygui myview moveInit
|
||||||
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
|
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
|
||||||
[Control] <- eventModifier
|
[Control] <- eventModifier
|
||||||
"v" <- fmap glibToString eventKeyName
|
"v" <- fmap glibToString eventKeyName
|
||||||
liftIO $ copyFinal mygui myview
|
liftIO $ operationFinal mygui myview
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
@ -122,6 +126,16 @@ del row mygui myview = withErrorDialog $ do
|
|||||||
$ easyDelete row >> refreshTreeView mygui myview Nothing
|
$ easyDelete row >> refreshTreeView mygui myview Nothing
|
||||||
|
|
||||||
|
|
||||||
|
-- |Initializes a file move operation.
|
||||||
|
--
|
||||||
|
-- Interaction with mutable references:
|
||||||
|
--
|
||||||
|
-- * 'operationBuffer' writes
|
||||||
|
moveInit :: Row -> MyGUI -> MyView -> IO ()
|
||||||
|
moveInit row mygui myview =
|
||||||
|
writeTVarIO (operationBuffer myview) (FMove . MP1 $ row)
|
||||||
|
|
||||||
|
|
||||||
-- |Supposed to be used with 'withRow'. Initializes a file copy operation.
|
-- |Supposed to be used with 'withRow'. Initializes a file copy operation.
|
||||||
--
|
--
|
||||||
-- Interaction with mutable references:
|
-- Interaction with mutable references:
|
||||||
@ -132,23 +146,29 @@ copyInit row mygui myview =
|
|||||||
writeTVarIO (operationBuffer myview) (FCopy . CP1 $ row)
|
writeTVarIO (operationBuffer myview) (FCopy . CP1 $ row)
|
||||||
|
|
||||||
|
|
||||||
-- |Finalizes a file copy operation.
|
-- |Finalizes a file operation, such as copy or move.
|
||||||
--
|
--
|
||||||
-- Interaction with mutable references:
|
-- Interaction with mutable references:
|
||||||
--
|
--
|
||||||
-- * 'operationBuffer' reads
|
-- * 'operationBuffer' reads
|
||||||
copyFinal :: MyGUI -> MyView -> IO ()
|
operationFinal :: MyGUI -> MyView -> IO ()
|
||||||
copyFinal mygui myview = withErrorDialog $ do
|
operationFinal mygui myview = withErrorDialog $ do
|
||||||
op <- readTVarIO (operationBuffer myview)
|
op <- readTVarIO (operationBuffer myview)
|
||||||
mcdir <- getFirstRow myview
|
cdir <- goUp =<< getFirstRow myview
|
||||||
case op of
|
case op of
|
||||||
|
FMove (MP1 s) -> do
|
||||||
|
let cmsg = "Really move \"" ++ fullPath s
|
||||||
|
++ "\"" ++ " to \"" ++ fullPath cdir ++ "\"?"
|
||||||
|
withConfirmationDialog cmsg
|
||||||
|
(runFileOp (FMove . MC s $ cdir)
|
||||||
|
>> refreshTreeView mygui myview Nothing)
|
||||||
|
return ()
|
||||||
FCopy (CP1 s) -> do
|
FCopy (CP1 s) -> do
|
||||||
dest <- goUp mcdir
|
|
||||||
let cmsg = "Really copy \"" ++ fullPath s
|
let cmsg = "Really copy \"" ++ fullPath s
|
||||||
++ "\"" ++ " to \"" ++ fullPath dest ++ "\"?"
|
++ "\"" ++ " to \"" ++ fullPath cdir ++ "\"?"
|
||||||
cm <- showCopyModeChooserDialog
|
cm <- showCopyModeChooserDialog
|
||||||
withConfirmationDialog cmsg
|
withConfirmationDialog cmsg
|
||||||
(runFileOp (FCopy . CC s dest $ cm)
|
(runFileOp (FCopy . CC s cdir $ cm)
|
||||||
>> refreshTreeView mygui myview Nothing)
|
>> refreshTreeView mygui myview Nothing)
|
||||||
return ()
|
return ()
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
|
Loading…
Reference in New Issue
Block a user