GTK: implement home and up buttons wrt #40
This commit is contained in:
parent
c0bd5f3c37
commit
e98fb577ed
@ -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>
|
||||
|
@ -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 $
|
||||
|
@ -72,6 +72,8 @@ data MyGUI = MkMyGUI {
|
||||
, rcFileRename :: ImageMenuItem
|
||||
, rcFilePaste :: ImageMenuItem
|
||||
, rcFileDelete :: ImageMenuItem
|
||||
, upViewB :: Button
|
||||
, homeViewB :: Button
|
||||
, refreshViewB :: Button
|
||||
, urlBar :: Entry
|
||||
, statusBar :: Statusbar
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user