GTK: implement fileinfo dialog wrt #32

This commit is contained in:
Julian Ospald 2016-04-19 21:05:29 +02:00
parent a7ba20ae00
commit a61b409486
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
6 changed files with 298 additions and 38 deletions

View File

@ -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>

View File

@ -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.

View File

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

View File

@ -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
@ -51,7 +52,26 @@ import System.INotify.ByteString
data MyGUI = MkMyGUI {
-- |main Window
rootWin :: Window
, menubarFileQuit :: ImageMenuItem
-- 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
}

View File

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

View File

@ -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