GTK: pre-set input field when renaming files
This commit is contained in:
parent
4254c80a64
commit
a25f92e4ec
@ -40,6 +40,10 @@ import Control.Monad.IO.Class
|
|||||||
(
|
(
|
||||||
liftIO
|
liftIO
|
||||||
)
|
)
|
||||||
|
import Data.ByteString
|
||||||
|
(
|
||||||
|
ByteString
|
||||||
|
)
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
(
|
(
|
||||||
for_
|
for_
|
||||||
@ -399,7 +403,7 @@ operationFinal mygui myview mitem = withErrorDialog $ do
|
|||||||
-- |Create a new file.
|
-- |Create a new file.
|
||||||
newFile :: MyGUI -> MyView -> IO ()
|
newFile :: MyGUI -> MyView -> IO ()
|
||||||
newFile _ myview = withErrorDialog $ do
|
newFile _ myview = withErrorDialog $ do
|
||||||
mfn <- textInputDialog "Enter file name"
|
mfn <- textInputDialog "Enter file name" ("" :: String)
|
||||||
let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
|
let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
|
||||||
for_ pmfn $ \fn -> do
|
for_ pmfn $ \fn -> do
|
||||||
cdir <- getCurrentDir myview
|
cdir <- getCurrentDir myview
|
||||||
@ -409,7 +413,7 @@ newFile _ myview = withErrorDialog $ do
|
|||||||
-- |Create a new directory.
|
-- |Create a new directory.
|
||||||
newDir :: MyGUI -> MyView -> IO ()
|
newDir :: MyGUI -> MyView -> IO ()
|
||||||
newDir _ myview = withErrorDialog $ do
|
newDir _ myview = withErrorDialog $ do
|
||||||
mfn <- textInputDialog "Enter directory name"
|
mfn <- textInputDialog "Enter directory name" ("" :: String)
|
||||||
let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
|
let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
|
||||||
for_ pmfn $ \fn -> do
|
for_ pmfn $ \fn -> do
|
||||||
cdir <- getCurrentDir myview
|
cdir <- getCurrentDir myview
|
||||||
@ -418,7 +422,8 @@ newDir _ myview = withErrorDialog $ do
|
|||||||
|
|
||||||
renameF :: [Item] -> MyGUI -> MyView -> IO ()
|
renameF :: [Item] -> MyGUI -> MyView -> IO ()
|
||||||
renameF [item] _ _ = withErrorDialog $ do
|
renameF [item] _ _ = withErrorDialog $ do
|
||||||
mfn <- textInputDialog "Enter new file name"
|
iname <- P.fromRel <$> (P.basename $ path item)
|
||||||
|
mfn <- textInputDialog "Enter new file name" (iname :: ByteString)
|
||||||
let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
|
let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
|
||||||
for_ pmfn $ \fn -> do
|
for_ pmfn $ \fn -> do
|
||||||
let cmsg = "Really rename \"" ++ getFPasStr item
|
let cmsg = "Really rename \"" ++ getFPasStr item
|
||||||
|
@ -81,7 +81,7 @@ _doFileOperation (f:fs) to mcOverwrite mc rest = do
|
|||||||
,(SameFile{} , collisionAction renameDialog topath)]
|
,(SameFile{} , collisionAction renameDialog topath)]
|
||||||
where
|
where
|
||||||
collisionAction diag topath = do
|
collisionAction diag topath = do
|
||||||
mcm <- diag . P.fpToString . P.fromAbs $ topath
|
mcm <- diag . P.fromAbs $ topath
|
||||||
forM_ mcm $ \cm -> case cm of
|
forM_ mcm $ \cm -> case cm of
|
||||||
Overwrite -> mcOverwrite f topath >> rest
|
Overwrite -> mcOverwrite f topath >> rest
|
||||||
OverwriteAll -> forM_ (f:fs) $ \x -> do
|
OverwriteAll -> forM_ (f:fs) $ \x -> do
|
||||||
|
@ -35,7 +35,15 @@ import Control.Monad
|
|||||||
, when
|
, when
|
||||||
, void
|
, void
|
||||||
)
|
)
|
||||||
|
import Data.ByteString
|
||||||
|
(
|
||||||
|
ByteString
|
||||||
|
)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
|
import Data.ByteString.UTF8
|
||||||
|
(
|
||||||
|
fromString
|
||||||
|
)
|
||||||
import Data.Version
|
import Data.Version
|
||||||
(
|
(
|
||||||
showVersion
|
showVersion
|
||||||
@ -70,6 +78,14 @@ import Paths_hsfm
|
|||||||
(
|
(
|
||||||
getDataFileName
|
getDataFileName
|
||||||
)
|
)
|
||||||
|
import System.Glib.UTFString
|
||||||
|
(
|
||||||
|
GlibString
|
||||||
|
)
|
||||||
|
import System.Posix.FilePath
|
||||||
|
(
|
||||||
|
takeFileName
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -111,14 +127,15 @@ showConfirmationDialog str = do
|
|||||||
_ -> return False
|
_ -> return False
|
||||||
|
|
||||||
|
|
||||||
fileCollisionDialog :: String -> IO (Maybe FCollisonMode)
|
fileCollisionDialog :: ByteString -> IO (Maybe FCollisonMode)
|
||||||
fileCollisionDialog t = do
|
fileCollisionDialog t = do
|
||||||
chooserDialog <- messageDialogNew Nothing
|
chooserDialog <- messageDialogNew Nothing
|
||||||
[DialogDestroyWithParent]
|
[DialogDestroyWithParent]
|
||||||
MessageQuestion
|
MessageQuestion
|
||||||
ButtonsNone
|
ButtonsNone
|
||||||
("Target \"" ++ t ++
|
(fromString "Target \"" `BS.append`
|
||||||
"\" exists, how to proceed?")
|
t `BS.append`
|
||||||
|
fromString "\" exists, how to proceed?")
|
||||||
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
|
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
|
||||||
_ <- dialogAddButton chooserDialog "Overwrite" (ResponseUser 1)
|
_ <- dialogAddButton chooserDialog "Overwrite" (ResponseUser 1)
|
||||||
_ <- dialogAddButton chooserDialog "Overwrite all" (ResponseUser 2)
|
_ <- dialogAddButton chooserDialog "Overwrite all" (ResponseUser 2)
|
||||||
@ -132,21 +149,22 @@ fileCollisionDialog t = do
|
|||||||
ResponseUser 2 -> return (Just OverwriteAll)
|
ResponseUser 2 -> return (Just OverwriteAll)
|
||||||
ResponseUser 3 -> return (Just Skip)
|
ResponseUser 3 -> return (Just Skip)
|
||||||
ResponseUser 4 -> do
|
ResponseUser 4 -> do
|
||||||
mfn <- textInputDialog "Enter new name"
|
mfn <- textInputDialog (fromString "Enter new name") (takeFileName t)
|
||||||
forM mfn $ \fn -> do
|
forM mfn $ \fn -> do
|
||||||
pfn <- P.parseFn (P.userStringToFP fn)
|
pfn <- P.parseFn (P.userStringToFP fn)
|
||||||
return $ Rename pfn
|
return $ Rename pfn
|
||||||
_ -> throw UnknownDialogButton
|
_ -> throw UnknownDialogButton
|
||||||
|
|
||||||
|
|
||||||
renameDialog :: String -> IO (Maybe FCollisonMode)
|
renameDialog :: ByteString -> IO (Maybe FCollisonMode)
|
||||||
renameDialog t = do
|
renameDialog t = do
|
||||||
chooserDialog <- messageDialogNew Nothing
|
chooserDialog <- messageDialogNew Nothing
|
||||||
[DialogDestroyWithParent]
|
[DialogDestroyWithParent]
|
||||||
MessageQuestion
|
MessageQuestion
|
||||||
ButtonsNone
|
ButtonsNone
|
||||||
("Target \"" ++ t ++
|
(fromString "Target \"" `BS.append`
|
||||||
"\" exists, how to proceed?")
|
t `BS.append`
|
||||||
|
fromString "\" exists, how to proceed?")
|
||||||
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
|
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
|
||||||
_ <- dialogAddButton chooserDialog "Skip" (ResponseUser 1)
|
_ <- dialogAddButton chooserDialog "Skip" (ResponseUser 1)
|
||||||
_ <- dialogAddButton chooserDialog "Rename" (ResponseUser 2)
|
_ <- dialogAddButton chooserDialog "Rename" (ResponseUser 2)
|
||||||
@ -156,7 +174,7 @@ renameDialog t = do
|
|||||||
ResponseUser 0 -> return Nothing
|
ResponseUser 0 -> return Nothing
|
||||||
ResponseUser 1 -> return (Just Skip)
|
ResponseUser 1 -> return (Just Skip)
|
||||||
ResponseUser 2 -> do
|
ResponseUser 2 -> do
|
||||||
mfn <- textInputDialog "Enter new name"
|
mfn <- textInputDialog (fromString "Enter new name") (takeFileName t)
|
||||||
forM mfn $ \fn -> do
|
forM mfn $ \fn -> do
|
||||||
pfn <- P.parseFn (P.userStringToFP fn)
|
pfn <- P.parseFn (P.userStringToFP fn)
|
||||||
return $ Rename pfn
|
return $ Rename pfn
|
||||||
@ -210,14 +228,18 @@ withErrorDialog io =
|
|||||||
|
|
||||||
-- |Asks the user which directory copy mode he wants via dialog popup
|
-- |Asks the user which directory copy mode he wants via dialog popup
|
||||||
-- and returns 'DirCopyMode'.
|
-- and returns 'DirCopyMode'.
|
||||||
textInputDialog :: String -> IO (Maybe String)
|
textInputDialog :: GlibString string
|
||||||
textInputDialog title = do
|
=> string -- ^ window title
|
||||||
|
-> string -- ^ initial text in input widget
|
||||||
|
-> IO (Maybe String)
|
||||||
|
textInputDialog title inittext = do
|
||||||
chooserDialog <- messageDialogNew Nothing
|
chooserDialog <- messageDialogNew Nothing
|
||||||
[DialogDestroyWithParent]
|
[DialogDestroyWithParent]
|
||||||
MessageQuestion
|
MessageQuestion
|
||||||
ButtonsNone
|
ButtonsNone
|
||||||
title
|
title
|
||||||
entry <- entryNew
|
entry <- entryNew
|
||||||
|
entrySetText entry inittext
|
||||||
cbox <- dialogGetActionArea chooserDialog
|
cbox <- dialogGetActionArea chooserDialog
|
||||||
_ <- dialogAddButton chooserDialog "Ok" (ResponseUser 0)
|
_ <- dialogAddButton chooserDialog "Ok" (ResponseUser 0)
|
||||||
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 1)
|
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 1)
|
||||||
|
Loading…
Reference in New Issue
Block a user