From e98fb577edb5a886756ffc7ef0215964d7e7837d Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 17 Apr 2016 01:01:04 +0200
Subject: [PATCH] GTK: implement home and up buttons wrt #40

---
 data/Gtk/builder.xml          | 45 ++++++++++++++++++++++++++++-------
 src/HSFM/GUI/Gtk/Callbacks.hs | 15 +++++++++++-
 src/HSFM/GUI/Gtk/Data.hs      |  2 ++
 src/HSFM/GUI/Gtk/MyGUI.hs     |  4 ++++
 4 files changed, 57 insertions(+), 9 deletions(-)

diff --git a/data/Gtk/builder.xml b/data/Gtk/builder.xml
index a81a15d..40990f3 100644
--- a/data/Gtk/builder.xml
+++ b/data/Gtk/builder.xml
@@ -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>
diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs
index 8b258c9..7fbea36 100644
--- a/src/HSFM/GUI/Gtk/Callbacks.hs
+++ b/src/HSFM/GUI/Gtk/Callbacks.hs
@@ -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 $
diff --git a/src/HSFM/GUI/Gtk/Data.hs b/src/HSFM/GUI/Gtk/Data.hs
index 76ddc2b..0c3cfbd 100644
--- a/src/HSFM/GUI/Gtk/Data.hs
+++ b/src/HSFM/GUI/Gtk/Data.hs
@@ -72,6 +72,8 @@ data MyGUI = MkMyGUI {
   , rcFileRename :: ImageMenuItem
   , rcFilePaste :: ImageMenuItem
   , rcFileDelete :: ImageMenuItem
+  , upViewB :: Button
+  , homeViewB :: Button
   , refreshViewB :: Button
   , urlBar :: Entry
   , statusBar :: Statusbar
diff --git a/src/HSFM/GUI/Gtk/MyGUI.hs b/src/HSFM/GUI/Gtk/MyGUI.hs
index 0edb16a..49bbed3 100644
--- a/src/HSFM/GUI/Gtk/MyGUI.hs
+++ b/src/HSFM/GUI/Gtk/MyGUI.hs
@@ -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