LIB/GTK: fix file renaming (previously called move)
This commit is contained in:
parent
5455ba1066
commit
3639dec1d3
@ -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>
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user