From a25f92e4ecbcbbee83bcccdedceeca8fc043c0cf Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Mon, 9 May 2016 00:45:47 +0200 Subject: [PATCH] GTK: pre-set input field when renaming files --- src/HSFM/GUI/Gtk/Callbacks.hs | 11 +++++--- src/HSFM/GUI/Gtk/Callbacks/Utils.hs | 2 +- src/HSFM/GUI/Gtk/Dialogs.hs | 42 ++++++++++++++++++++++------- 3 files changed, 41 insertions(+), 14 deletions(-) diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index 67f3167..d9a8321 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/src/HSFM/GUI/Gtk/Callbacks.hs @@ -40,6 +40,10 @@ import Control.Monad.IO.Class ( liftIO ) +import Data.ByteString + ( + ByteString + ) import Data.Foldable ( for_ @@ -399,7 +403,7 @@ operationFinal mygui myview mitem = withErrorDialog $ do -- |Create a new file. newFile :: MyGUI -> MyView -> IO () newFile _ myview = withErrorDialog $ do - mfn <- textInputDialog "Enter file name" + mfn <- textInputDialog "Enter file name" ("" :: String) let pmfn = P.parseFn =<< P.userStringToFP <$> mfn for_ pmfn $ \fn -> do cdir <- getCurrentDir myview @@ -409,7 +413,7 @@ newFile _ myview = withErrorDialog $ do -- |Create a new directory. newDir :: MyGUI -> MyView -> IO () newDir _ myview = withErrorDialog $ do - mfn <- textInputDialog "Enter directory name" + mfn <- textInputDialog "Enter directory name" ("" :: String) let pmfn = P.parseFn =<< P.userStringToFP <$> mfn for_ pmfn $ \fn -> do cdir <- getCurrentDir myview @@ -418,7 +422,8 @@ newDir _ myview = withErrorDialog $ do renameF :: [Item] -> MyGUI -> MyView -> IO () 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 for_ pmfn $ \fn -> do let cmsg = "Really rename \"" ++ getFPasStr item diff --git a/src/HSFM/GUI/Gtk/Callbacks/Utils.hs b/src/HSFM/GUI/Gtk/Callbacks/Utils.hs index 2594c5d..dea52cb 100644 --- a/src/HSFM/GUI/Gtk/Callbacks/Utils.hs +++ b/src/HSFM/GUI/Gtk/Callbacks/Utils.hs @@ -81,7 +81,7 @@ _doFileOperation (f:fs) to mcOverwrite mc rest = do ,(SameFile{} , collisionAction renameDialog topath)] where collisionAction diag topath = do - mcm <- diag . P.fpToString . P.fromAbs $ topath + mcm <- diag . P.fromAbs $ topath forM_ mcm $ \cm -> case cm of Overwrite -> mcOverwrite f topath >> rest OverwriteAll -> forM_ (f:fs) $ \x -> do diff --git a/src/HSFM/GUI/Gtk/Dialogs.hs b/src/HSFM/GUI/Gtk/Dialogs.hs index 3849689..4a10cba 100644 --- a/src/HSFM/GUI/Gtk/Dialogs.hs +++ b/src/HSFM/GUI/Gtk/Dialogs.hs @@ -35,7 +35,15 @@ import Control.Monad , when , void ) +import Data.ByteString + ( + ByteString + ) import qualified Data.ByteString as BS +import Data.ByteString.UTF8 + ( + fromString + ) import Data.Version ( showVersion @@ -70,6 +78,14 @@ import Paths_hsfm ( getDataFileName ) +import System.Glib.UTFString + ( + GlibString + ) +import System.Posix.FilePath + ( + takeFileName + ) @@ -111,14 +127,15 @@ showConfirmationDialog str = do _ -> return False -fileCollisionDialog :: String -> IO (Maybe FCollisonMode) +fileCollisionDialog :: ByteString -> IO (Maybe FCollisonMode) fileCollisionDialog t = do chooserDialog <- messageDialogNew Nothing [DialogDestroyWithParent] MessageQuestion ButtonsNone - ("Target \"" ++ t ++ - "\" exists, how to proceed?") + (fromString "Target \"" `BS.append` + t `BS.append` + fromString "\" exists, how to proceed?") _ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0) _ <- dialogAddButton chooserDialog "Overwrite" (ResponseUser 1) _ <- dialogAddButton chooserDialog "Overwrite all" (ResponseUser 2) @@ -132,21 +149,22 @@ fileCollisionDialog t = do ResponseUser 2 -> return (Just OverwriteAll) ResponseUser 3 -> return (Just Skip) ResponseUser 4 -> do - mfn <- textInputDialog "Enter new name" + mfn <- textInputDialog (fromString "Enter new name") (takeFileName t) forM mfn $ \fn -> do pfn <- P.parseFn (P.userStringToFP fn) return $ Rename pfn _ -> throw UnknownDialogButton -renameDialog :: String -> IO (Maybe FCollisonMode) +renameDialog :: ByteString -> IO (Maybe FCollisonMode) renameDialog t = do chooserDialog <- messageDialogNew Nothing [DialogDestroyWithParent] MessageQuestion ButtonsNone - ("Target \"" ++ t ++ - "\" exists, how to proceed?") + (fromString "Target \"" `BS.append` + t `BS.append` + fromString "\" exists, how to proceed?") _ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0) _ <- dialogAddButton chooserDialog "Skip" (ResponseUser 1) _ <- dialogAddButton chooserDialog "Rename" (ResponseUser 2) @@ -156,7 +174,7 @@ renameDialog t = do ResponseUser 0 -> return Nothing ResponseUser 1 -> return (Just Skip) ResponseUser 2 -> do - mfn <- textInputDialog "Enter new name" + mfn <- textInputDialog (fromString "Enter new name") (takeFileName t) forM mfn $ \fn -> do pfn <- P.parseFn (P.userStringToFP fn) return $ Rename pfn @@ -210,14 +228,18 @@ withErrorDialog io = -- |Asks the user which directory copy mode he wants via dialog popup -- and returns 'DirCopyMode'. -textInputDialog :: String -> IO (Maybe String) -textInputDialog title = do +textInputDialog :: GlibString string + => string -- ^ window title + -> string -- ^ initial text in input widget + -> IO (Maybe String) +textInputDialog title inittext = do chooserDialog <- messageDialogNew Nothing [DialogDestroyWithParent] MessageQuestion ButtonsNone title entry <- entryNew + entrySetText entry inittext cbox <- dialogGetActionArea chooserDialog _ <- dialogAddButton chooserDialog "Ok" (ResponseUser 0) _ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 1)