LIB/GTK: fix file renaming (previously called move)

This commit is contained in:
Julian Ospald 2015-12-26 03:04:28 +01:00
parent 5455ba1066
commit 3639dec1d3
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
5 changed files with 52 additions and 18 deletions

View File

@ -62,8 +62,8 @@
</object> </object>
</child> </child>
<child> <child>
<object class="GtkImageMenuItem" id="rcFileMove"> <object class="GtkImageMenuItem" id="rcFileRename">
<property name="label">Move</property> <property name="label">Rename</property>
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
<property name="image">image1</property> <property name="image">image1</property>
@ -190,7 +190,7 @@
</object> </object>
</child> </child>
<child> <child>
<object class="GtkImageMenuItem" id="menubarEditMove"> <object class="GtkImageMenuItem" id="menubarEditRename">
<property name="label">Move</property> <property name="label">Move</property>
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>

View File

@ -177,8 +177,8 @@ startMainWindow startdir = do
"menubarEditCut" "menubarEditCut"
menubarEditCopy <- builderGetObject builder castToImageMenuItem menubarEditCopy <- builderGetObject builder castToImageMenuItem
"menubarEditCopy" "menubarEditCopy"
menubarEditMove <- builderGetObject builder castToImageMenuItem menubarEditRename <- builderGetObject builder castToImageMenuItem
"menubarEditMove" "menubarEditRename"
menubarEditPaste <- builderGetObject builder castToImageMenuItem menubarEditPaste <- builderGetObject builder castToImageMenuItem
"menubarEditPaste" "menubarEditPaste"
menubarEditDelete <- builderGetObject builder castToImageMenuItem menubarEditDelete <- builderGetObject builder castToImageMenuItem
@ -201,8 +201,8 @@ startMainWindow startdir = do
"rcFileCut" "rcFileCut"
rcFileCopy <- builderGetObject builder castToImageMenuItem rcFileCopy <- builderGetObject builder castToImageMenuItem
"rcFileCopy" "rcFileCopy"
rcFileMove <- builderGetObject builder castToImageMenuItem rcFileRename <- builderGetObject builder castToImageMenuItem
"rcFileMove" "rcFileRename"
rcFilePaste <- builderGetObject builder castToImageMenuItem rcFilePaste <- builderGetObject builder castToImageMenuItem
"rcFilePaste" "rcFilePaste"
rcFileDelete <- builderGetObject builder castToImageMenuItem rcFileDelete <- builderGetObject builder castToImageMenuItem

View File

@ -41,6 +41,10 @@ import Control.Monad.IO.Class
liftIO liftIO
) )
import Data.DirTree import Data.DirTree
import Data.Foldable
(
for_
)
import Graphics.UI.Gtk import Graphics.UI.Gtk
import GUI.Gtk.Data import GUI.Gtk.Data
import GUI.Gtk.Dialogs import GUI.Gtk.Dialogs
@ -125,16 +129,16 @@ setCallbacks mygui myview = do
liftIO $ newFile mygui myview liftIO $ newFile mygui myview
-- menubar-edit -- menubar-edit
_ <- menubarEditCut mygui `on` menuItemActivated $
liftIO $ withRow mygui myview moveInit
_ <- menubarEditCopy mygui `on` menuItemActivated $ _ <- menubarEditCopy mygui `on` menuItemActivated $
liftIO $ withRow mygui myview copyInit liftIO $ withRow mygui myview copyInit
_ <- menubarEditMove mygui `on` menuItemActivated $ _ <- menubarEditRename mygui `on` menuItemActivated $
liftIO $ withRow mygui myview moveInit liftIO $ withRow mygui myview renameF
_ <- menubarEditPaste mygui `on` menuItemActivated $ _ <- menubarEditPaste mygui `on` menuItemActivated $
liftIO $ operationFinal mygui myview liftIO $ operationFinal mygui myview
_ <- menubarEditDelete mygui `on` menuItemActivated $ _ <- menubarEditDelete mygui `on` menuItemActivated $
liftIO $ withRow mygui myview del liftIO $ withRow mygui myview del
_ <- menubarEditCut mygui `on` menuItemActivated $
liftIO $ withRow mygui myview moveInit
-- menubar-help -- menubar-help
_ <- menubarHelpAbout mygui `on` menuItemActivated $ _ <- menubarHelpAbout mygui `on` menuItemActivated $
@ -156,8 +160,8 @@ setCallbacks mygui myview = do
liftIO $ newFile mygui myview liftIO $ newFile mygui myview
_ <- rcFileCopy mygui `on` menuItemActivated $ _ <- rcFileCopy mygui `on` menuItemActivated $
liftIO $ withRow mygui myview copyInit liftIO $ withRow mygui myview copyInit
_ <- rcFileMove mygui `on` menuItemActivated $ _ <- rcFileRename mygui `on` menuItemActivated $
liftIO $ withRow mygui myview moveInit liftIO $ withRow mygui myview renameF
_ <- rcFilePaste mygui `on` menuItemActivated $ _ <- rcFilePaste mygui `on` menuItemActivated $
liftIO $ operationFinal mygui myview liftIO $ operationFinal mygui myview
_ <- rcFileDelete mygui `on` menuItemActivated $ _ <- rcFileDelete mygui `on` menuItemActivated $
@ -271,9 +275,19 @@ upDir mygui myview = withErrorDialog $ do
-- |Go up one directory and visualize it in the treeView. -- |Go up one directory and visualize it in the treeView.
newFile :: MyGUI -> MyView -> IO () newFile :: MyGUI -> MyView -> IO ()
newFile mygui myview = withErrorDialog $ do newFile mygui myview = withErrorDialog $ do
cdir <- getCurrentDir myview
mfn <- textInputDialog "Enter file name" mfn <- textInputDialog "Enter file name"
maybe (return ()) (\fn -> do for_ mfn $ \fn -> do
cdir <- getCurrentDir myview
createFile cdir fn createFile cdir fn
refreshTreeView' mygui myview cdir refreshTreeView' mygui myview cdir
) mfn
renameF :: Row -> MyGUI -> MyView -> IO ()
renameF row mygui myview = withErrorDialog $ do
mfn <- textInputDialog "Enter new file name"
for_ mfn $ \fn -> do
let cmsg = "Really rename \"" ++ fullPath row
++ "\"" ++ " to \"" ++ anchor row </> fn ++ "\"?"
withConfirmationDialog cmsg $ IO.File.renameFile row fn
cdir <- getCurrentDir myview
refreshTreeView' mygui myview cdir

View File

@ -50,7 +50,7 @@ data MyGUI = MkMyGUI {
, menubarFileNew :: ImageMenuItem , menubarFileNew :: ImageMenuItem
, menubarEditCut :: ImageMenuItem , menubarEditCut :: ImageMenuItem
, menubarEditCopy :: ImageMenuItem , menubarEditCopy :: ImageMenuItem
, menubarEditMove :: ImageMenuItem , menubarEditRename :: ImageMenuItem
, menubarEditPaste :: ImageMenuItem , menubarEditPaste :: ImageMenuItem
, menubarEditDelete :: ImageMenuItem , menubarEditDelete :: ImageMenuItem
, menubarHelpAbout :: ImageMenuItem , menubarHelpAbout :: ImageMenuItem
@ -60,7 +60,7 @@ data MyGUI = MkMyGUI {
, rcFileNew :: ImageMenuItem , rcFileNew :: ImageMenuItem
, rcFileCut :: ImageMenuItem , rcFileCut :: ImageMenuItem
, rcFileCopy :: ImageMenuItem , rcFileCopy :: ImageMenuItem
, rcFileMove :: ImageMenuItem , rcFileRename :: ImageMenuItem
, rcFilePaste :: ImageMenuItem , rcFilePaste :: ImageMenuItem
, rcFileDelete :: ImageMenuItem , rcFileDelete :: ImageMenuItem
, refreshView :: Button , refreshView :: Button

View File

@ -81,6 +81,7 @@ import System.Posix.Files
, otherWriteMode , otherWriteMode
, ownerReadMode , ownerReadMode
, ownerWriteMode , ownerWriteMode
, rename
, touchFile , touchFile
, unionFileModes , unionFileModes
) )
@ -411,3 +412,22 @@ createFile (SADir td) fn = do
`uf` otherReadMode `uf` otherReadMode
fd <- System.Posix.IO.createFile fullp mode fd <- System.Posix.IO.createFile fullp mode
closeFd fd closeFd fd
---------------------
--[ File Renaming ]--
---------------------
renameFile :: AnchoredFile FileInfo -> FileName -> IO ()
renameFile (_ :/ Failed {}) _ = return ()
renameFile _ "." = return ()
renameFile _ ".." = return ()
renameFile af fn = do
let fromf = fullPath af
tof = anchor af </> fn
throwFileDoesExist tof
throwSameFile fromf tof
rename fromf tof