diff --git a/Paths_hsfm.html b/Paths_hsfm.html index 9edbce3..0bd468a 100644 --- a/Paths_hsfm.html +++ b/Paths_hsfm.html @@ -1,4 +1,4 @@ Paths_hsfm

hsfm-gtk

Safe HaskellSafe
LanguageHaskell2010

Paths_hsfm

Documentation

version :: Version Source #

getBinDir :: IO FilePath Source #

getLibDir :: IO FilePath Source #

getDataDir :: IO FilePath Source #

getLibexecDir :: IO FilePath Source #

getDataFileName :: FilePath -> IO FilePath Source #

getSysconfDir :: IO FilePath Source #

\ No newline at end of file +

hsfm-gtk

Safe HaskellSafe
LanguageHaskell2010

Paths_hsfm

Documentation

version :: Version Source #

getBinDir :: IO FilePath Source #

getLibDir :: IO FilePath Source #

getDataDir :: IO FilePath Source #

getLibexecDir :: IO FilePath Source #

getDataFileName :: FilePath -> IO FilePath Source #

getSysconfDir :: IO FilePath Source #

\ No newline at end of file diff --git a/src/HSFM-GUI-Gtk-Dialogs.html b/src/HSFM-GUI-Gtk-Dialogs.html index 0f41613..66c4012 100644 --- a/src/HSFM-GUI-Gtk-Dialogs.html +++ b/src/HSFM-GUI-Gtk-Dialogs.html @@ -30,284 +30,290 @@ module HSFM.GUI.Gtk.Dialogs where -import Control.Exception +import Codec.Binary.UTF8.String ( - displayException - , throwIO - , IOException - , catches - , Handler(..) - ) -import Control.Monad - ( - forM - , when - , void - ) -import Data.ByteString - ( - ByteString + decodeString + ) +import Control.Exception + ( + catches + , displayException + , throwIO + , IOException + , Handler(..) + ) +import Control.Monad + ( + forM + , when + , void ) -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 - ( - fromString - ) -import Data.Version +import Data.ByteString + ( + ByteString + ) +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 ( - showVersion + fromString ) -import Distribution.Package +import Data.Version ( - PackageIdentifier(..) - , PackageName(..) - ) -import Distribution.PackageDescription - ( - GenericPackageDescription(..) - , PackageDescription(..) - ) -import Distribution.PackageDescription.Parse - ( - readPackageDescription + showVersion + ) +import Distribution.Package + ( + PackageIdentifier(..) + , PackageName(..) + ) +import Distribution.PackageDescription + ( + GenericPackageDescription(..) + , PackageDescription(..) ) -import Distribution.Verbosity +import Distribution.PackageDescription.Parse ( - silent + readPackageDescription ) -import Graphics.UI.Gtk -import qualified HPath as P -import HPath.IO.Errors -import HSFM.FileSystem.FileType -import HSFM.FileSystem.UtilTypes -import HSFM.GUI.Glib.GlibString() -import HSFM.GUI.Gtk.Data -import HSFM.GUI.Gtk.Errors -import Paths_hsfm - ( - getDataFileName - ) -import System.Glib.UTFString +import Distribution.Verbosity + ( + silent + ) +import Graphics.UI.Gtk +import qualified HPath as P +import HPath.IO.Errors +import HSFM.FileSystem.FileType +import HSFM.FileSystem.UtilTypes +import HSFM.GUI.Glib.GlibString() +import HSFM.GUI.Gtk.Data +import HSFM.GUI.Gtk.Errors +import Paths_hsfm ( - GlibString + getDataFileName ) -import System.Posix.FilePath +import System.Glib.UTFString ( - takeFileName + GlibString ) - - - - +import System.Posix.FilePath + ( + takeFileName + ) - --------------------- - --[ Dialog popups ]-- - --------------------- + + + - --- |Pops up an error Dialog with the given String. -showErrorDialog :: String -> IO () -showErrorDialog str = do - errorDialog <- messageDialogNew Nothing - [DialogDestroyWithParent] - MessageError - ButtonsClose - str - _ <- dialogRun errorDialog - widgetDestroy errorDialog - - --- |Asks the user for confirmation and returns True/False. -showConfirmationDialog :: String -> IO Bool -showConfirmationDialog str = do - confirmDialog <- messageDialogNew Nothing - [DialogDestroyWithParent] - MessageQuestion - ButtonsYesNo - str - rID <- dialogRun confirmDialog - widgetDestroy confirmDialog - case rID of - ResponseYes -> return True - ResponseNo -> return False - _ -> return False - - -fileCollisionDialog :: ByteString -> IO (Maybe FCollisonMode) -fileCollisionDialog t = do - chooserDialog <- messageDialogNew Nothing - [DialogDestroyWithParent] - MessageQuestion - ButtonsNone - (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) - _ <- dialogAddButton chooserDialog "Skip" (ResponseUser 3) - _ <- dialogAddButton chooserDialog "Rename" (ResponseUser 4) - rID <- dialogRun chooserDialog - widgetDestroy chooserDialog - case rID of - ResponseUser 0 -> return Nothing - ResponseUser 1 -> return (Just Overwrite) - ResponseUser 2 -> return (Just OverwriteAll) - ResponseUser 3 -> return (Just Skip) - ResponseUser 4 -> do - mfn <- textInputDialog (fromString "Enter new name") (takeFileName t) - forM mfn $ \fn -> do - pfn <- P.parseFn (fromString fn) - return $ Rename pfn - _ -> throwIO UnknownDialogButton - - -renameDialog :: ByteString -> IO (Maybe FCollisonMode) -renameDialog t = do - chooserDialog <- messageDialogNew Nothing - [DialogDestroyWithParent] - MessageQuestion - ButtonsNone - (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) - rID <- dialogRun chooserDialog - widgetDestroy chooserDialog - case rID of - ResponseUser 0 -> return Nothing - ResponseUser 1 -> return (Just Skip) - ResponseUser 2 -> do - mfn <- textInputDialog (fromString "Enter new name") (takeFileName t) - forM mfn $ \fn -> do - pfn <- P.parseFn (fromString fn) - return $ Rename pfn - _ -> throwIO UnknownDialogButton - - --- |Shows the about dialog from the help menu. -showAboutDialog :: IO () -showAboutDialog = do - ad <- aboutDialogNew - lstr <- Prelude.readFile =<< getDataFileName "LICENSE" - hsfmicon <- pixbufNewFromFile =<< getDataFileName "data/Gtk/icons/hsfm.png" - pdesc <- fmap packageDescription - (readPackageDescription silent - =<< getDataFileName "hsfm.cabal") - set ad - [ aboutDialogProgramName := (unPackageName . pkgName . package) pdesc - , aboutDialogName := (unPackageName . pkgName . package) pdesc - , aboutDialogVersion := (showVersion . pkgVersion . package) pdesc - , aboutDialogCopyright := copyright pdesc - , aboutDialogComments := description pdesc - , aboutDialogLicense := Just lstr - , aboutDialogWebsite := homepage pdesc - , aboutDialogAuthors := [author pdesc] - , aboutDialogLogo := Just hsfmicon - , aboutDialogWrapLicense := True - ] - _ <- dialogRun ad - widgetDestroy ad - - --- |Carry out an IO action with a confirmation dialog. --- If the user presses "No", then do nothing. -withConfirmationDialog :: String -> IO () -> IO () -withConfirmationDialog str io = do - run <- showConfirmationDialog str - when run io - - --- |Execute the given IO action. If the action throws exceptions, --- visualize them via 'showErrorDialog'. -withErrorDialog :: IO a -> IO () -withErrorDialog io = - catches (void io) - [ Handler (\e -> showErrorDialog - $ displayException (e :: IOException)) - , Handler (\e -> showErrorDialog - $ displayException (e :: HPathIOException)) - ] - - --- |Asks the user which directory copy mode he wants via dialog popup --- and returns 'DirCopyMode'. -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) - boxPackStart (castToBox cbox) entry PackNatural 5 - widgetShowAll chooserDialog - rID <- dialogRun chooserDialog - ret <- case rID of - -- TODO: make this more safe - ResponseUser 0 -> Just <$> entryGetText entry - ResponseUser 1 -> return Nothing - _ -> throwIO UnknownDialogButton - widgetDestroy chooserDialog - return ret - - -showFilePropertyDialog :: [Item] -> MyGUI -> MyView -> IO () -showFilePropertyDialog [item] mygui _ = do - dialog <- messageDialogNew Nothing - [DialogDestroyWithParent] - MessageInfo - ButtonsNone - "File Properties" - - let fprop' = fprop mygui - grid = fpropGrid fprop' - - entrySetText (fpropFnEntry fprop') (maybe BS.empty P.fromRel - $ P.basename . path $ item) - entrySetText (fpropLocEntry fprop') (P.fromAbs . P.dirname . path $ item) - entrySetText (fpropTsEntry fprop') (fromFreeVar (show . fileSize) item) - entrySetText (fpropModEntry fprop') (packModTime item) - entrySetText (fpropAcEntry fprop') (packAccessTime item) - entrySetText (fpropFTEntry fprop') (packFileType item) - entrySetText (fpropPermEntry fprop') - (tail $ packPermissions item) -- throw away the filetype part - case packLinkDestination item of - (Just dest) -> do - widgetSetSensitive (fpropLDEntry fprop') True - entrySetText (fpropLDEntry fprop') dest - Nothing -> do - widgetSetSensitive (fpropLDEntry fprop') False - entrySetText (fpropLDEntry fprop') "( Not a symlink )" - - - cbox <- dialogGetActionArea dialog - _ <- dialogAddButton dialog "Ok" (ResponseUser 0) - _ <- dialogAddButton dialog "Cancel" (ResponseUser 1) - boxPackStart (castToBox cbox) grid PackNatural 5 + --------------------- + --[ Dialog popups ]-- + --------------------- + + +-- |Pops up an error Dialog with the given String. +showErrorDialog :: String -> IO () +showErrorDialog str = do + errorDialog <- messageDialogNew Nothing + [DialogDestroyWithParent] + MessageError + ButtonsClose + str + _ <- dialogRun errorDialog + widgetDestroy errorDialog + + +-- |Asks the user for confirmation and returns True/False. +showConfirmationDialog :: String -> IO Bool +showConfirmationDialog str = do + confirmDialog <- messageDialogNew Nothing + [DialogDestroyWithParent] + MessageQuestion + ButtonsYesNo + str + rID <- dialogRun confirmDialog + widgetDestroy confirmDialog + case rID of + ResponseYes -> return True + ResponseNo -> return False + _ -> return False + + +fileCollisionDialog :: ByteString -> IO (Maybe FCollisonMode) +fileCollisionDialog t = do + chooserDialog <- messageDialogNew Nothing + [DialogDestroyWithParent] + MessageQuestion + ButtonsNone + (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) + _ <- dialogAddButton chooserDialog "Skip" (ResponseUser 3) + _ <- dialogAddButton chooserDialog "Rename" (ResponseUser 4) + rID <- dialogRun chooserDialog + widgetDestroy chooserDialog + case rID of + ResponseUser 0 -> return Nothing + ResponseUser 1 -> return (Just Overwrite) + ResponseUser 2 -> return (Just OverwriteAll) + ResponseUser 3 -> return (Just Skip) + ResponseUser 4 -> do + mfn <- textInputDialog (fromString "Enter new name") (takeFileName t) + forM mfn $ \fn -> do + pfn <- P.parseFn (fromString fn) + return $ Rename pfn + _ -> throwIO UnknownDialogButton + + +renameDialog :: ByteString -> IO (Maybe FCollisonMode) +renameDialog t = do + chooserDialog <- messageDialogNew Nothing + [DialogDestroyWithParent] + MessageQuestion + ButtonsNone + (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) + rID <- dialogRun chooserDialog + widgetDestroy chooserDialog + case rID of + ResponseUser 0 -> return Nothing + ResponseUser 1 -> return (Just Skip) + ResponseUser 2 -> do + mfn <- textInputDialog (fromString "Enter new name") (takeFileName t) + forM mfn $ \fn -> do + pfn <- P.parseFn (fromString fn) + return $ Rename pfn + _ -> throwIO UnknownDialogButton + + +-- |Shows the about dialog from the help menu. +showAboutDialog :: IO () +showAboutDialog = do + ad <- aboutDialogNew + lstr <- Prelude.readFile =<< getDataFileName "LICENSE" + hsfmicon <- pixbufNewFromFile =<< getDataFileName "data/Gtk/icons/hsfm.png" + pdesc <- fmap packageDescription + (readPackageDescription silent + =<< getDataFileName "hsfm.cabal") + set ad + [ aboutDialogProgramName := (unPackageName . pkgName . package) pdesc + , aboutDialogName := (unPackageName . pkgName . package) pdesc + , aboutDialogVersion := (showVersion . pkgVersion . package) pdesc + , aboutDialogCopyright := copyright pdesc + , aboutDialogComments := description pdesc + , aboutDialogLicense := Just lstr + , aboutDialogWebsite := homepage pdesc + , aboutDialogAuthors := [author pdesc] + , aboutDialogLogo := Just hsfmicon + , aboutDialogWrapLicense := True + ] + _ <- dialogRun ad + widgetDestroy ad + + +-- |Carry out an IO action with a confirmation dialog. +-- If the user presses "No", then do nothing. +withConfirmationDialog :: String -> IO () -> IO () +withConfirmationDialog str io = do + run <- showConfirmationDialog str + when run io + + +-- |Execute the given IO action. If the action throws exceptions, +-- visualize them via 'showErrorDialog'. +withErrorDialog :: IO a -> IO () +withErrorDialog io = + catches (void io) + [ Handler (\e -> showErrorDialog + . decodeString + . displayException + $ (e :: IOException)) + , Handler (\e -> showErrorDialog + $ displayException (e :: HPathIOException)) + ] + + +-- |Asks the user which directory copy mode he wants via dialog popup +-- and returns 'DirCopyMode'. +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) + boxPackStart (castToBox cbox) entry PackNatural 5 + widgetShowAll chooserDialog + rID <- dialogRun chooserDialog + ret <- case rID of + -- TODO: make this more safe + ResponseUser 0 -> Just <$> entryGetText entry + ResponseUser 1 -> return Nothing + _ -> throwIO UnknownDialogButton + widgetDestroy chooserDialog + return ret + + +showFilePropertyDialog :: [Item] -> MyGUI -> MyView -> IO () +showFilePropertyDialog [item] mygui _ = do + dialog <- messageDialogNew Nothing + [DialogDestroyWithParent] + MessageInfo + ButtonsNone + "File Properties" + + let fprop' = fprop mygui + grid = fpropGrid fprop' + + entrySetText (fpropFnEntry fprop') (maybe BS.empty P.fromRel + $ P.basename . path $ item) + entrySetText (fpropLocEntry fprop') (P.fromAbs . P.dirname . path $ item) + entrySetText (fpropTsEntry fprop') (fromFreeVar (show . fileSize) item) + entrySetText (fpropModEntry fprop') (packModTime item) + entrySetText (fpropAcEntry fprop') (packAccessTime item) + entrySetText (fpropFTEntry fprop') (packFileType item) + entrySetText (fpropPermEntry fprop') + (tail $ packPermissions item) -- throw away the filetype part + case packLinkDestination item of + (Just dest) -> do + widgetSetSensitive (fpropLDEntry fprop') True + entrySetText (fpropLDEntry fprop') dest + Nothing -> do + widgetSetSensitive (fpropLDEntry fprop') False + entrySetText (fpropLDEntry fprop') "( Not a symlink )" - widgetShowAll dialog - _ <- dialogRun dialog - - -- make sure our grid does not get destroyed - containerRemove (castToBox cbox) grid + + cbox <- dialogGetActionArea dialog + _ <- dialogAddButton dialog "Ok" (ResponseUser 0) + _ <- dialogAddButton dialog "Cancel" (ResponseUser 1) + boxPackStart (castToBox cbox) grid PackNatural 5 - widgetDestroy dialog - - return () -showFilePropertyDialog _ _ _ = return () - + widgetShowAll dialog + _ <- dialogRun dialog + + -- make sure our grid does not get destroyed + containerRemove (castToBox cbox) grid + + widgetDestroy dialog + + return () +showFilePropertyDialog _ _ _ = return () +