GTK: implement home and up buttons wrt #40

This commit is contained in:
Julian Ospald 2016-04-17 01:01:04 +02:00
parent c0bd5f3c37
commit e98fb577ed
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
4 changed files with 57 additions and 9 deletions

View File

@ -1,5 +1,5 @@
<?xml version="1.0" encoding="UTF-8"?>
<!-- Generated with glade 3.19.0 -->
<!-- Generated with glade 3.18.3 -->
<interface>
<requires lib="gtk+" version="3.16"/>
<object class="GtkImage" id="image1">
@ -104,6 +104,11 @@
<property name="can_focus">False</property>
<property name="stock">gtk-zoom-fit</property>
</object>
<object class="GtkImage" id="image5">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="stock">gtk-zoom-fit</property>
</object>
<object class="GtkApplicationWindow" id="rootWin">
<property name="can_focus">False</property>
<child>
@ -307,6 +312,35 @@
<property name="position">0</property>
</packing>
</child>
<child>
<object class="GtkButton" id="upViewB">
<property name="label">gtk-go-up</property>
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="receives_default">True</property>
<property name="use_stock">True</property>
</object>
<packing>
<property name="expand">False</property>
<property name="fill">True</property>
<property name="padding">2</property>
<property name="position">1</property>
</packing>
</child>
<child>
<object class="GtkButton" id="homeViewB">
<property name="label">gtk-home</property>
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="receives_default">True</property>
<property name="use_stock">True</property>
</object>
<packing>
<property name="expand">False</property>
<property name="fill">True</property>
<property name="position">2</property>
</packing>
</child>
<child>
<object class="GtkButton" id="refreshViewB">
<property name="label">gtk-refresh</property>
@ -318,8 +352,8 @@
<packing>
<property name="expand">False</property>
<property name="fill">True</property>
<property name="padding">5</property>
<property name="position">1</property>
<property name="padding">2</property>
<property name="position">3</property>
</packing>
</child>
</object>
@ -396,9 +430,4 @@
</object>
</child>
</object>
<object class="GtkImage" id="image5">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="stock">gtk-zoom-fit</property>
</object>
</interface>

View File

@ -63,7 +63,10 @@ import System.Glib.UTFString
(
glibToString
)
import System.Posix.Env.ByteString
(
getEnv
)
@ -128,6 +131,10 @@ setCallbacks mygui myview = do
-- GUI events
_ <- urlBar mygui `on` entryActivated $ urlGoTo mygui myview
_ <- upViewB mygui `on` buttonActivated $
upDir mygui myview
_ <- homeViewB mygui `on` buttonActivated $
goHome mygui myview
_ <- refreshViewB mygui `on` buttonActivated $ do
cdir <- liftIO $ getCurrentDir myview
refreshView' mygui myview cdir
@ -234,6 +241,12 @@ urlGoTo mygui myview = withErrorDialog $ do
refreshView mygui myview (Just fp')
goHome :: MyGUI -> MyView -> IO ()
goHome mygui myview = withErrorDialog $ do
mhomedir <- getEnv "HOME"
refreshView mygui myview (P.parseAbs =<< mhomedir)
-- |Supposed to be used with 'withRows'. Opens a file or directory.
open :: [Item] -> MyGUI -> MyView -> IO ()
open [item] mygui myview = withErrorDialog $

View File

@ -72,6 +72,8 @@ data MyGUI = MkMyGUI {
, rcFileRename :: ImageMenuItem
, rcFilePaste :: ImageMenuItem
, rcFileDelete :: ImageMenuItem
, upViewB :: Button
, homeViewB :: Button
, refreshViewB :: Button
, urlBar :: Entry
, statusBar :: Statusbar

View File

@ -99,6 +99,10 @@ createMyGUI = do
"rcFilePaste"
rcFileDelete <- builderGetObject builder castToImageMenuItem
"rcFileDelete"
upViewB <- builderGetObject builder castToButton
"upViewB"
homeViewB <- builderGetObject builder castToButton
"homeViewB"
refreshViewB <- builderGetObject builder castToButton
"refreshViewB"
menubarViewTree <- builderGetObject builder castToImageMenuItem