From a61b40948627fbf61ab478d7f70d3548a52a4cc0 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 19 Apr 2016 21:05:29 +0200 Subject: [PATCH] GTK: implement fileinfo dialog wrt #32 --- data/Gtk/builder.xml | 166 ++++++++++++++++++++++++++++++++ src/HSFM/FileSystem/FileType.hs | 14 ++- src/HSFM/GUI/Gtk/Callbacks.hs | 49 +++++----- src/HSFM/GUI/Gtk/Data.hs | 47 ++++++--- src/HSFM/GUI/Gtk/Dialogs.hs | 42 +++++++- src/HSFM/GUI/Gtk/MyGUI.hs | 18 ++++ 6 files changed, 298 insertions(+), 38 deletions(-) diff --git a/data/Gtk/builder.xml b/data/Gtk/builder.xml index 6e57043..3a3b58d 100644 --- a/data/Gtk/builder.xml +++ b/data/Gtk/builder.xml @@ -2,6 +2,163 @@ + + True + False + 2 + 2 + True + + + True + False + start + File Name: + + + + + + 0 + 0 + + + + + 350 + True + True + 5 + 2 + 2 + False + + + 1 + 0 + + + + + True + False + start + Location: + + + + + + 0 + 1 + + + + + True + False + start + Total Size: + + + + + + 0 + 2 + + + + + True + False + start + Modified: + + + + + + 0 + 3 + + + + + True + False + start + Accessed: + + + + + + 0 + 4 + + + + + 350 + True + True + 5 + 2 + 2 + False + + + 1 + 1 + + + + + 350 + True + True + 5 + 2 + 2 + False + + + 1 + 2 + + + + + 350 + True + True + 5 + 2 + 2 + False + + + 1 + 3 + + + + + 350 + True + True + 5 + 2 + 2 + False + + + 1 + 4 + + + True False @@ -458,5 +615,14 @@ True + + + gtk-properties + True + False + True + True + + diff --git a/src/HSFM/FileSystem/FileType.hs b/src/HSFM/FileSystem/FileType.hs index ef1af5e..3a910ae 100644 --- a/src/HSFM/FileSystem/FileType.hs +++ b/src/HSFM/FileSystem/FileType.hs @@ -563,9 +563,17 @@ getFreeVar _ = Nothing -- |Pack the modification time into a string. packModTime :: File FileInfo -> String -packModTime = - fromFreeVar - $ show . posixSecondsToUTCTime . realToFrac . modificationTime +packModTime = fromFreeVar $ epochToString . modificationTime + + +-- |Pack the modification time into a string. +packAccessTime :: File FileInfo + -> String +packAccessTime = fromFreeVar $ epochToString . accessTime + + +epochToString :: EpochTime -> String +epochToString = show . posixSecondsToUTCTime . realToFrac -- |Pack the permissions into a string, similar to what "ls -l" does. diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index fad8899..60fdead 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/src/HSFM/GUI/Gtk/Callbacks.hs @@ -90,7 +90,6 @@ setCallbacks mygui myview = do \_ -> withItems mygui myview moveInit _ <- treeView `on` dragDrop $ \dc p ts -> do - atom <- atomNew ("HSFM" :: String) p' <- treeViewConvertWidgetToTreeCoords treeView p mpath <- treeViewGetPathAtPos treeView p' case mpath of @@ -98,6 +97,7 @@ setCallbacks mygui myview = do dragFinish dc False False ts return False Just _ -> do + atom <- atomNew ("HSFM" :: String) dragGetData treeView dc atom ts return True _ <- treeView `on` dragDataReceived $ @@ -125,34 +125,35 @@ setCallbacks mygui myview = do where menubarCallbacks = do -- menubar-file - _ <- menubarFileQuit mygui `on` menuItemActivated $ mainQuit - _ <- menubarFileOpen mygui `on` menuItemActivated $ + _ <- (menubarFileQuit . menubar) mygui `on` menuItemActivated $ + mainQuit + _ <- (menubarFileOpen . menubar) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview open - _ <- menubarFileExecute mygui `on` menuItemActivated $ + _ <- (menubarFileExecute . menubar) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview execute - _ <- menubarFileNew mygui `on` menuItemActivated $ + _ <- (menubarFileNew . menubar) mygui `on` menuItemActivated $ liftIO $ newFile mygui myview -- menubar-edit - _ <- menubarEditCut mygui `on` menuItemActivated $ + _ <- (menubarEditCut . menubar) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview moveInit - _ <- menubarEditCopy mygui `on` menuItemActivated $ + _ <- (menubarEditCopy . menubar) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview copyInit - _ <- menubarEditRename mygui `on` menuItemActivated $ + _ <- (menubarEditRename . menubar) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview renameF - _ <- menubarEditPaste mygui `on` menuItemActivated $ + _ <- (menubarEditPaste . menubar) mygui `on` menuItemActivated $ liftIO $ operationFinal mygui myview Nothing - _ <- menubarEditDelete mygui `on` menuItemActivated $ + _ <- (menubarEditDelete . menubar) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview del -- mewnubar-view - _ <- menubarViewIcon mygui `on` menuItemActivated $ + _ <- (menubarViewIcon . menubar) mygui `on` menuItemActivated $ liftIO $ switchView mygui myview createIconView - _ <- menubarViewTree mygui `on` menuItemActivated $ + _ <- (menubarViewTree . menubar) mygui `on` menuItemActivated $ liftIO $ switchView mygui myview createTreeView -- menubar-help - _ <- menubarHelpAbout mygui `on` menuItemActivated $ + _ <- (menubarHelpAbout . menubar) mygui `on` menuItemActivated $ liftIO showAboutDialog return () commonGuiEvents fmv = do @@ -214,7 +215,7 @@ setCallbacks mygui myview = do t <- eventTime case eb of RightButton -> do - _ <- liftIO $ menuPopup (rcMenu mygui) + _ <- liftIO $ menuPopup (rcMenu . rcmenu $ mygui) $ Just (RightButton, t) -- this is just to not screw with current selection -- on right-click @@ -232,23 +233,25 @@ setCallbacks mygui myview = do Nothing -> return False -- not right-click, so pass on the signal _ -> return False - _ <- rcFileOpen mygui `on` menuItemActivated $ + _ <- (rcFileOpen . rcmenu) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview open - _ <- rcFileExecute mygui `on` menuItemActivated $ + _ <- (rcFileExecute . rcmenu) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview execute - _ <- rcFileNewRegFile mygui `on` menuItemActivated $ + _ <- (rcFileNewRegFile . rcmenu) mygui `on` menuItemActivated $ liftIO $ newFile mygui myview - _ <- rcFileNewDir mygui `on` menuItemActivated $ + _ <- (rcFileNewDir . rcmenu) mygui `on` menuItemActivated $ liftIO $ newDir mygui myview - _ <- rcFileCopy mygui `on` menuItemActivated $ + _ <- (rcFileCopy . rcmenu) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview copyInit - _ <- rcFileRename mygui `on` menuItemActivated $ + _ <- (rcFileRename . rcmenu) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview renameF - _ <- rcFilePaste mygui `on` menuItemActivated $ + _ <- (rcFilePaste . rcmenu) mygui `on` menuItemActivated $ liftIO $ operationFinal mygui myview Nothing - _ <- rcFileDelete mygui `on` menuItemActivated $ + _ <- (rcFileDelete . rcmenu) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview del - _ <- rcFileCut mygui `on` menuItemActivated $ + _ <- (rcFileProperty . rcmenu) mygui `on` menuItemActivated $ + liftIO $ withItems mygui myview showFilePropertyDialog + _ <- (rcFileCut . rcmenu) mygui `on` menuItemActivated $ liftIO $ withItems mygui myview moveInit return () getPathAtPos fmv (x, y) = diff --git a/src/HSFM/GUI/Gtk/Data.hs b/src/HSFM/GUI/Gtk/Data.hs index 0072223..bf40243 100644 --- a/src/HSFM/GUI/Gtk/Data.hs +++ b/src/HSFM/GUI/Gtk/Data.hs @@ -30,6 +30,7 @@ import Control.Concurrent.STM TVar ) import Graphics.UI.Gtk +import Graphics.UI.Gtk hiding (MenuBar) import HSFM.FileSystem.FileOperations import HSFM.FileSystem.FileType import System.INotify.ByteString @@ -50,8 +51,27 @@ import System.INotify.ByteString -- runtime. data MyGUI = MkMyGUI { -- |main Window - rootWin :: Window - , menubarFileQuit :: ImageMenuItem + rootWin :: Window + + -- widgets on the main window + , upViewB :: Button + , homeViewB :: Button + , refreshViewB :: Button + , urlBar :: Entry + , statusBar :: Statusbar + , clearStatusBar :: Button + , settings :: TVar FMSettings + , scroll :: ScrolledWindow + + , fprop :: FilePropertyGrid + + -- sub-widgets + , menubar :: MenuBar + , rcmenu :: RightClickMenu +} + +data MenuBar = MkMenuBar { + menubarFileQuit :: ImageMenuItem , menubarFileOpen :: ImageMenuItem , menubarFileExecute :: ImageMenuItem , menubarFileNew :: ImageMenuItem @@ -63,7 +83,10 @@ data MyGUI = MkMyGUI { , menubarViewTree :: ImageMenuItem , menubarViewIcon :: ImageMenuItem , menubarHelpAbout :: ImageMenuItem - , rcMenu :: Menu +} + +data RightClickMenu = MkRightClickMenu { + rcMenu :: Menu , rcFileOpen :: ImageMenuItem , rcFileExecute :: ImageMenuItem , rcFileNewRegFile :: ImageMenuItem @@ -73,14 +96,16 @@ data MyGUI = MkMyGUI { , rcFileRename :: ImageMenuItem , rcFilePaste :: ImageMenuItem , rcFileDelete :: ImageMenuItem - , upViewB :: Button - , homeViewB :: Button - , refreshViewB :: Button - , urlBar :: Entry - , statusBar :: Statusbar - , clearStatusBar :: Button - , settings :: TVar FMSettings - , scroll :: ScrolledWindow + , rcFileProperty :: ImageMenuItem +} + +data FilePropertyGrid = MkFilePropertyGrid { + fpropGrid :: Grid + , fpropFnEntry :: Entry + , fpropLocEntry :: Entry + , fpropTsEntry :: Entry + , fpropModEntry :: Entry + , fpropAcEntry :: Entry } diff --git a/src/HSFM/GUI/Gtk/Dialogs.hs b/src/HSFM/GUI/Gtk/Dialogs.hs index b9ec29d..4541346 100644 --- a/src/HSFM/GUI/Gtk/Dialogs.hs +++ b/src/HSFM/GUI/Gtk/Dialogs.hs @@ -36,6 +36,7 @@ import Control.Monad , when , void ) +import qualified Data.ByteString as BS import Data.Version ( showVersion @@ -62,6 +63,9 @@ import Graphics.UI.Gtk import qualified HPath as P import HSFM.FileSystem.Errors import HSFM.FileSystem.FileOperations +import HSFM.FileSystem.FileType +import HSFM.GUI.Glib.GlibString() +import HSFM.GUI.Gtk.Data import HSFM.GUI.Gtk.Errors import Paths_hsfm ( @@ -180,7 +184,7 @@ withCopyModeDialog fa = showAboutDialog :: IO () showAboutDialog = do ad <- aboutDialogNew - lstr <- readFile =<< getDataFileName "LICENSE" + lstr <- Prelude.readFile =<< getDataFileName "LICENSE" hsfmicon <- pixbufNewFromFile =<< getDataFileName "data/Gtk/icons/hsfm.png" pdesc <- fmap packageDescription (readPackageDescription silent @@ -244,3 +248,39 @@ textInputDialog title = do _ -> throw 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) + + cbox <- dialogGetActionArea dialog + _ <- dialogAddButton dialog "Ok" (ResponseUser 0) + _ <- dialogAddButton dialog "Cancel" (ResponseUser 1) + boxPackStart (castToBox cbox) grid PackNatural 5 + + widgetShowAll dialog + _ <- dialogRun dialog + + -- make sure our grid does not get destroyed + containerRemove (castToBox cbox) grid + + widgetDestroy dialog + + return () +showFilePropertyDialog _ _ _ = return () + diff --git a/src/HSFM/GUI/Gtk/MyGUI.hs b/src/HSFM/GUI/Gtk/MyGUI.hs index 6939d4a..cf1ec8f 100644 --- a/src/HSFM/GUI/Gtk/MyGUI.hs +++ b/src/HSFM/GUI/Gtk/MyGUI.hs @@ -16,6 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. --} +{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_HADDOCK ignore-exports #-} module HSFM.GUI.Gtk.MyGUI where @@ -101,6 +102,8 @@ createMyGUI = do "rcFilePaste" rcFileDelete <- builderGetObject builder castToImageMenuItem "rcFileDelete" + rcFileProperty <- builderGetObject builder castToImageMenuItem + "rcFileProperty" upViewB <- builderGetObject builder castToButton "upViewB" homeViewB <- builderGetObject builder castToButton @@ -111,8 +114,23 @@ createMyGUI = do "menubarViewTree" menubarViewIcon <- builderGetObject builder castToImageMenuItem "menubarViewIcon" + fpropGrid <- builderGetObject builder castToGrid + "fpropGrid" + fpropFnEntry <- builderGetObject builder castToEntry + "fpropFnEntry" + fpropLocEntry <- builderGetObject builder castToEntry + "fpropLocEntry" + fpropTsEntry <- builderGetObject builder castToEntry + "fpropTsEntry" + fpropModEntry <- builderGetObject builder castToEntry + "fpropModEntry" + fpropAcEntry <- builderGetObject builder castToEntry + "fpropAcEntry" -- construct the gui object + let menubar = MkMenuBar {..} + let rcmenu = MkRightClickMenu {..} + let fprop = MkFilePropertyGrid {..} let mygui = MkMyGUI {..} -- sets the default icon