GTK: implement fileinfo dialog wrt #32

data/Gtk/builder.xml

@@ -2,6 +2,163 @@
 <!-- Generated with glade 3.18.3 -->
 <interface>
   <requires lib="gtk+" version="3.16"/>
+  <object class="GtkGrid" id="fpropGrid">
+    <property name="visible">True</property>
+    <property name="can_focus">False</property>
+    <property name="row_spacing">2</property>
+    <property name="column_spacing">2</property>
+    <property name="row_homogeneous">True</property>
+    <child>
+      <object class="GtkLabel" id="label1">
+        <property name="visible">True</property>
+        <property name="can_focus">False</property>
+        <property name="halign">start</property>
+        <property name="label" translatable="yes">File Name:</property>
+        <attributes>
+          <attribute name="weight" value="bold"/>
+        </attributes>
+      </object>
+      <packing>
+        <property name="left_attach">0</property>
+        <property name="top_attach">0</property>
+      </packing>
+    </child>
+    <child>
+      <object class="GtkEntry" id="fpropFnEntry">
+        <property name="width_request">350</property>
+        <property name="visible">True</property>
+        <property name="can_focus">True</property>
+        <property name="margin_left">5</property>
+        <property name="margin_top">2</property>
+        <property name="margin_bottom">2</property>
+        <property name="editable">False</property>
+      </object>
+      <packing>
+        <property name="left_attach">1</property>
+        <property name="top_attach">0</property>
+      </packing>
+    </child>
+    <child>
+      <object class="GtkLabel" id="label2">
+        <property name="visible">True</property>
+        <property name="can_focus">False</property>
+        <property name="halign">start</property>
+        <property name="label" translatable="yes">Location:</property>
+        <attributes>
+          <attribute name="weight" value="bold"/>
+        </attributes>
+      </object>
+      <packing>
+        <property name="left_attach">0</property>
+        <property name="top_attach">1</property>
+      </packing>
+    </child>
+    <child>
+      <object class="GtkLabel" id="label3">
+        <property name="visible">True</property>
+        <property name="can_focus">False</property>
+        <property name="halign">start</property>
+        <property name="label" translatable="yes">Total Size:</property>
+        <attributes>
+          <attribute name="weight" value="bold"/>
+        </attributes>
+      </object>
+      <packing>
+        <property name="left_attach">0</property>
+        <property name="top_attach">2</property>
+      </packing>
+    </child>
+    <child>
+      <object class="GtkLabel" id="label4">
+        <property name="visible">True</property>
+        <property name="can_focus">False</property>
+        <property name="halign">start</property>
+        <property name="label" translatable="yes">Modified:</property>
+        <attributes>
+          <attribute name="weight" value="bold"/>
+        </attributes>
+      </object>
+      <packing>
+        <property name="left_attach">0</property>
+        <property name="top_attach">3</property>
+      </packing>
+    </child>
+    <child>
+      <object class="GtkLabel" id="label5">
+        <property name="visible">True</property>
+        <property name="can_focus">False</property>
+        <property name="halign">start</property>
+        <property name="label" translatable="yes">Accessed:</property>
+        <attributes>
+          <attribute name="weight" value="bold"/>
+        </attributes>
+      </object>
+      <packing>
+        <property name="left_attach">0</property>
+        <property name="top_attach">4</property>
+      </packing>
+    </child>
+    <child>
+      <object class="GtkEntry" id="fpropLocEntry">
+        <property name="width_request">350</property>
+        <property name="visible">True</property>
+        <property name="can_focus">True</property>
+        <property name="margin_left">5</property>
+        <property name="margin_top">2</property>
+        <property name="margin_bottom">2</property>
+        <property name="editable">False</property>
+      </object>
+      <packing>
+        <property name="left_attach">1</property>
+        <property name="top_attach">1</property>
+      </packing>
+    </child>
+    <child>
+      <object class="GtkEntry" id="fpropTsEntry">
+        <property name="width_request">350</property>
+        <property name="visible">True</property>
+        <property name="can_focus">True</property>
+        <property name="margin_left">5</property>
+        <property name="margin_top">2</property>
+        <property name="margin_bottom">2</property>
+        <property name="editable">False</property>
+      </object>
+      <packing>
+        <property name="left_attach">1</property>
+        <property name="top_attach">2</property>
+      </packing>
+    </child>
+    <child>
+      <object class="GtkEntry" id="fpropModEntry">
+        <property name="width_request">350</property>
+        <property name="visible">True</property>
+        <property name="can_focus">True</property>
+        <property name="margin_left">5</property>
+        <property name="margin_top">2</property>
+        <property name="margin_bottom">2</property>
+        <property name="editable">False</property>
+      </object>
+      <packing>
+        <property name="left_attach">1</property>
+        <property name="top_attach">3</property>
+      </packing>
+    </child>
+    <child>
+      <object class="GtkEntry" id="fpropAcEntry">
+        <property name="width_request">350</property>
+        <property name="visible">True</property>
+        <property name="can_focus">True</property>
+        <property name="margin_left">5</property>
+        <property name="margin_top">2</property>
+        <property name="margin_bottom">2</property>
+        <property name="editable">False</property>
+      </object>
+      <packing>
+        <property name="left_attach">1</property>
+        <property name="top_attach">4</property>
+      </packing>
+    </child>
+  </object>
   <object class="GtkImage" id="image1">
     <property name="visible">True</property>
     <property name="can_focus">False</property>
@@ -458,5 +615,14 @@
         <property name="use_stock">True</property>
       </object>
     </child>
+    <child>
+      <object class="GtkImageMenuItem" id="rcFileProperty">
+        <property name="label">gtk-properties</property>
+        <property name="visible">True</property>
+        <property name="can_focus">False</property>
+        <property name="use_underline">True</property>
+        <property name="use_stock">True</property>
+      </object>
+    </child>
   </object>
 </interface>

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.

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) =

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
 }
 
 

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 ()
+

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