Update freeze file

This also touches some exception handling code, be careful.

.gitignore

@@ -1,9 +1,15 @@
-dist/
-.cabal-sandbox/
-cabal.sandbox.config
-*~
 *.hp
-*.prof
 *.old
+*.prof
+*~
+.cabal-sandbox/
+.ghc.environment.*
 .liquid/
+.stack-work/
 3rdparty/hpath
+cabal.sandbox.config
+dist-newstyle/
+dist/
+hscope.out
+.ghcup
+/bin/

.travis.yml

@@ -0,0 +1,68 @@
+# See https://github.com/hvr/multi-ghc-travis for more information
+
+language: c
+
+sudo: required
+dist: trusty
+
+matrix:
+  include:
+    - env: CABALVER=1.24 GHCVER=8.0.1
+      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
+    - env: CABALVER=2.0 GHCVER=8.2.2
+      addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}
+    - env: CABALVER=2.2 GHCVER=8.4.1
+      addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.1], sources: [hvr-ghc]}}
+    - env: CABALVER=head GHCVER=head
+      addons: {apt: {packages: [cabal-install-head,ghc-head,libgtk2.0-dev,libgtk-3-dev],  sources: [hvr-ghc]}}
+
+  allow_failures:
+    - env: CABALVER=head GHCVER=head
+
+env:
+  global:
+    - secure: "qAzj5tgAghFIfO6R/+Hdc5KcFhwXKNXMICNH7VLmqLzmYxk1UEkpi6hgX/f1bP5mLd07D+0IaeGFIUIWQOp+F/Du1NiX3yGbFuTt/Ja4I0K4ooCQc0w9uYLv8epxzp3VEOEI5sVCSpSomFjr7V0jwwTcBbxGUvv1VaGkJwAexRxCHuwU23KD0toECkVDsOMN/Gg2Ue/r2o+MsGx1/B9WMF0g6+zWlnrYfYZXWetl0DwATK5lZTa/21THdMrbuPX0fijGXTywvURDpCd3wIdfx9n7jPO2Gp2rcxPL/WkcIpzI211g4hEiheS+AlVyW39+C4i4MKaNK8YC+/5DRl/YHrFc7n3SZPDh+RMs6r3DS41RyRhQhz8DE0Pg4zfe/WUX4+h72TijCZ1zduh146rofwku/IGtCz5cuel+7cmTPk9ZyENYnH0ZMftkZjor9J/KamcMsN4zfaQBNJuIM3Kg8HVts3ymNIWrJ1LUn41MNt1eBDDvOWxZaHrjLyATRCFYvMr4RE01pqYKnWZ9RFfzVaYjD0QQWPWAXcCtkcAHSR6T0NxAqjLmHBNm+yWYIKG+bK2CvPNYTTNN8n4UvY1SrBpJEnLcRRns3U8nM7SVZ4GMaYzOTWtN1n0zamsl42wV0L/wqpz1SePkRZ34jca3V07XRLQSN2wjj8DyvOZUFR0="
+
+before_install:
+ - sudo apt-get install -y hscolour
+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
+
+install:
+ - cabal --version
+ - travis_retry cabal update
+ - cabal sandbox init
+ - cabal install alex happy
+ - export PATH="$(pwd)/.cabal-sandbox/bin:$PATH"
+ - cabal install gtk2hs-buildtools
+ - cabal install --only-dependencies --enable-tests -j
+
+script:
+ - cabal configure --enable-tests -v2
+ - cabal build
+ - cabal test
+ - cabal check
+ - cabal sdist
+# check that the generated source-distribution can be built & installed
+ - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
+   cd dist/;
+   cabal sandbox init;
+   if [ -f "$SRC_TGZ" ]; then
+      cabal install alex happy;
+      export PATH="$(pwd)/.cabal-sandbox/bin:$PATH";
+      cabal install gtk2hs-buildtools;
+      cabal install "$SRC_TGZ" --enable-tests;
+   else
+      echo "expected '$SRC_TGZ' not found";
+      exit 1;
+   fi;
+   cd ..
+ - sed -i -e '/hsfm,/d' hsfm.cabal
+ - cabal haddock --executables --internal --hyperlink-source --html-location=https://hackage.haskell.org/package/\$pkg-\$version/docs/
+
+after_script:
+    - ./update-gh-pages.sh
+
+notifications:
+  email:
+    - hasufell@posteo.de
+

README.md

@@ -1,7 +1,8 @@
 HSFM
 ====
 
-__NOTE: This project is in a highly experimental state! Don't complain if it deletes your whole home directory. You should use a chroot, docker environment or similar for testing.__
+[![Join the chat at https://gitter.im/hasufell/hsfm](https://badges.gitter.im/hasufell/hsfm.svg)](https://gitter.im/hasufell/hsfm?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
+[![Build Status](https://api.travis-ci.org/hasufell/hsfm.png?branch=master)](https://travis-ci.org/hasufell/hsfm)
 
 A Gtk+:3 filemanager written in Haskell.
 
@@ -15,17 +16,13 @@ Design goals:
 Screenshots
 -----------
 
-![hsfm](https://cloud.githubusercontent.com/assets/1241845/14768900/06efd43c-0a4d-11e6-939e-6b067bdb47ce.png "hsfm-gtk")
+![hsfm](https://cloud.githubusercontent.com/assets/1241845/20034565/6c3ae80e-a3c2-11e6-882c-9fe0ff202045.png "hsfm-gtk")
 
 Installation
 ------------
 
 ```
-cabal sandbox init
+./install.sh
-cabal install alex happy
-export PATH="$(pwd)/.cabal-sandbox/bin:$PATH"
-cabal install gtk2hs-buildtools
-cabal install
 ```
 
 

cabal.project

@@ -0,0 +1,10 @@
+with-compiler: ghc-8.6.5
+
+packages: .
+
+optimization: 2
+
+package *
+    optimization: 2
+
+index-state: 2020-01-24T20:23:40Z

cabal.project.freeze

@@ -0,0 +1,80 @@
+constraints: any.Cabal ==2.4.0.1,
+             any.IfElse ==0.85,
+             any.abstract-deque ==0.3,
+             abstract-deque -usecas,
+             any.alex ==3.2.5,
+             alex +small_base,
+             any.array ==0.5.3.0,
+             any.atomic-primops ==0.8.3,
+             atomic-primops -debug,
+             any.base ==4.12.0.0,
+             any.base-orphans ==0.8.1,
+             any.binary ==0.8.6.0,
+             any.bytestring ==0.10.8.2,
+             any.cairo ==0.13.8.0,
+             cairo +cairo_pdf +cairo_ps +cairo_svg,
+             any.containers ==0.6.0.1,
+             any.deepseq ==1.4.4.0,
+             any.directory ==1.3.3.0,
+             any.exceptions ==0.10.4,
+             exceptions +transformers-0-4,
+             any.filepath ==1.4.2.1,
+             any.ghc-boot-th ==8.6.5,
+             any.ghc-prim ==0.5.3,
+             any.gio ==0.13.8.0,
+             any.glib ==0.13.8.0,
+             glib +closure_signals,
+             any.gtk2hs-buildtools ==0.13.8.0,
+             gtk2hs-buildtools +closuresignals,
+             any.gtk3 ==0.15.4,
+             gtk3 -build-demos +fmode-binary +have-gio,
+             any.happy ==1.19.12,
+             happy +small_base,
+             any.hashable ==1.3.0.0,
+             hashable -examples +integer-gmp +sse2 -sse41,
+             any.hashtables ==1.2.3.4,
+             hashtables -bounds-checking -debug -detailed-profiling -portable -sse42 +unsafe-tricks,
+             any.heaps ==0.3.6.1,
+             any.hinotify-bytestring ==0.3.8.1,
+             any.hpath ==0.11.0,
+             any.hpath-filepath ==0.10.3,
+             any.hpath-io ==0.12.0,
+             any.hsc2hs ==0.68.6,
+             hsc2hs -in-ghc-tree,
+             any.integer-gmp ==1.0.2.0,
+             any.lockfree-queue ==0.2.3.1,
+             any.monad-control ==1.0.2.3,
+             any.monad-loops ==0.4.3,
+             monad-loops +base4,
+             any.mtl ==2.2.2,
+             any.network ==3.1.1.1,
+             any.old-locale ==1.0.0.7,
+             any.pango ==0.13.8.0,
+             pango +new-exception,
+             any.parsec ==3.1.13.0,
+             any.pretty ==1.1.3.6,
+             any.primitive ==0.7.0.0,
+             any.process ==1.6.5.0,
+             any.random ==1.1,
+             any.rts ==1.0,
+             any.safe ==0.3.18,
+             any.safe-exceptions ==0.1.7.0,
+             any.simple-sendfile ==0.2.30,
+             simple-sendfile +allow-bsd,
+             any.stm ==2.5.0.0,
+             any.streamly ==0.7.0,
+             streamly -benchmark -debug -dev -examples -examples-sdl -has-llvm -inspection -no-charts -no-fusion -streamk,
+             any.template-haskell ==2.14.0.0,
+             any.text ==1.2.3.1,
+             any.time ==1.8.0.2,
+             any.transformers ==0.5.6.2,
+             any.transformers-base ==0.4.5.2,
+             transformers-base +orphaninstances,
+             any.transformers-compat ==0.6.5,
+             transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
+             any.unix ==2.7.2.2,
+             any.unix-bytestring ==0.3.7.3,
+             any.utf8-string ==1.0.1.1,
+             any.vector ==0.12.0.3,
+             vector +boundschecks -internalchecks -unsafechecks -wall,
+             any.word8 ==0.1.3

data/Gtk/builder.xml

@@ -1,5 +1,5 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<!-- Generated with glade 3.18.3 -->
+<!-- Generated with glade 3.20.0 -->
 <interface>
   <requires lib="gtk+" version="3.16"/>
   <object class="GtkGrid" id="fpropGrid">
@@ -361,39 +361,123 @@
           </packing>
         </child>
         <child>
-          <object class="GtkNotebook" id="notebook">
+          <object class="GtkBox">
             <property name="visible">True</property>
-            <property name="can_focus">True</property>
+            <property name="can_focus">False</property>
-            <property name="scrollable">True</property>
             <child>
-              <placeholder/>
+              <object class="GtkPaned">
-            </child>
+                <property name="visible">True</property>
-            <child type="tab">
+                <property name="can_focus">True</property>
-              <placeholder/>
+                <child>
-            </child>
+                  <object class="GtkNotebook" id="notebook1">
-            <child>
+                    <property name="visible">True</property>
-              <placeholder/>
+                    <property name="can_focus">True</property>
-            </child>
+                    <property name="scrollable">True</property>
-            <child type="tab">
+                    <child>
-              <placeholder/>
+                      <placeholder/>
-            </child>
+                    </child>
-            <child>
+                    <child type="tab">
-              <placeholder/>
+                      <placeholder/>
-            </child>
+                    </child>
-            <child type="tab">
+                    <child>
-              <placeholder/>
+                      <placeholder/>
+                    </child>
+                    <child type="tab">
+                      <placeholder/>
+                    </child>
+                    <child>
+                      <placeholder/>
+                    </child>
+                    <child type="tab">
+                      <placeholder/>
+                    </child>
+                  </object>
+                  <packing>
+                    <property name="resize">True</property>
+                    <property name="shrink">True</property>
+                  </packing>
+                </child>
+                <child>
+                  <object class="GtkNotebook" id="notebook2">
+                    <property name="visible">True</property>
+                    <property name="can_focus">True</property>
+                    <property name="scrollable">True</property>
+                    <child>
+                      <placeholder/>
+                    </child>
+                    <child type="tab">
+                      <placeholder/>
+                    </child>
+                    <child>
+                      <placeholder/>
+                    </child>
+                    <child type="tab">
+                      <placeholder/>
+                    </child>
+                    <child>
+                      <placeholder/>
+                    </child>
+                    <child type="tab">
+                      <placeholder/>
+                    </child>
+                  </object>
+                  <packing>
+                    <property name="resize">True</property>
+                    <property name="shrink">True</property>
+                  </packing>
+                </child>
+              </object>
+              <packing>
+                <property name="expand">True</property>
+                <property name="fill">True</property>
+                <property name="position">2</property>
+              </packing>
             </child>
           </object>
           <packing>
             <property name="expand">True</property>
             <property name="fill">True</property>
-            <property name="position">2</property>
+            <property name="position">1</property>
           </packing>
         </child>
         <child>
           <object class="GtkBox" id="box3">
             <property name="visible">True</property>
             <property name="can_focus">False</property>
+            <child>
+              <object class="GtkToggleButton" id="leftNbBtn">
+                <property name="visible">True</property>
+                <property name="can_focus">True</property>
+                <property name="receives_default">True</property>
+                <property name="margin_left">5</property>
+                <property name="margin_right">5</property>
+                <property name="margin_top">5</property>
+                <property name="margin_bottom">5</property>
+                <property name="relief">none</property>
+                <property name="always_show_image">True</property>
+                <child>
+                  <placeholder/>
+                </child>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">0</property>
+              </packing>
+            </child>
+            <child>
+              <object class="GtkSeparator">
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <property name="margin_left">2</property>
+                <property name="margin_right">2</property>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">1</property>
+              </packing>
+            </child>
             <child>
               <object class="GtkStatusbar" id="statusBar">
                 <property name="visible">True</property>
@@ -410,7 +494,7 @@
               <packing>
                 <property name="expand">True</property>
                 <property name="fill">True</property>
-                <property name="position">0</property>
+                <property name="position">2</property>
               </packing>
             </child>
             <child>
@@ -427,14 +511,48 @@
               <packing>
                 <property name="expand">False</property>
                 <property name="fill">True</property>
-                <property name="position">1</property>
+                <property name="position">3</property>
+              </packing>
+            </child>
+            <child>
+              <object class="GtkSeparator">
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <property name="margin_left">2</property>
+                <property name="margin_right">2</property>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">4</property>
+              </packing>
+            </child>
+            <child>
+              <object class="GtkToggleButton" id="rightNbBtn">
+                <property name="visible">True</property>
+                <property name="can_focus">True</property>
+                <property name="receives_default">True</property>
+                <property name="margin_left">5</property>
+                <property name="margin_right">5</property>
+                <property name="margin_top">5</property>
+                <property name="margin_bottom">5</property>
+                <property name="relief">none</property>
+                <property name="always_show_image">True</property>
+                <child>
+                  <placeholder/>
+                </child>
+              </object>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">5</property>
               </packing>
             </child>
           </object>
           <packing>
             <property name="expand">False</property>
             <property name="fill">True</property>
-            <property name="position">3</property>
+            <property name="position">2</property>
           </packing>
         </child>
       </object>
@@ -460,6 +578,16 @@
     <property name="can_focus">False</property>
     <property name="stock">gtk-zoom-fit</property>
   </object>
+  <object class="GtkImage" id="image8">
+    <property name="visible">True</property>
+    <property name="can_focus">False</property>
+    <property name="stock">gtk-add</property>
+  </object>
+  <object class="GtkImage" id="image9">
+    <property name="visible">True</property>
+    <property name="can_focus">False</property>
+    <property name="icon_name">utilities-terminal</property>
+  </object>
   <object class="GtkMenu" id="rcMenu">
     <property name="visible">True</property>
     <property name="can_focus">False</property>
@@ -510,6 +638,30 @@
                 <property name="use_stock">False</property>
               </object>
             </child>
+            <child>
+              <object class="GtkSeparatorMenuItem" id="separatormenuitem4">
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+              </object>
+            </child>
+            <child>
+              <object class="GtkImageMenuItem" id="rcFileNewTab">
+                <property name="label" translatable="yes">Tab</property>
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <property name="image">image8</property>
+                <property name="use_stock">False</property>
+              </object>
+            </child>
+            <child>
+              <object class="GtkImageMenuItem" id="rcFileNewTerm">
+                <property name="label" translatable="yes">Terminal</property>
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <property name="image">image9</property>
+                <property name="use_stock">False</property>
+              </object>
+            </child>
           </object>
         </child>
       </object>
@@ -543,7 +695,6 @@
         <property name="label">Rename</property>
         <property name="visible">True</property>
         <property name="can_focus">False</property>
-        <property name="image">image1</property>
         <property name="use_stock">False</property>
       </object>
     </child>
@@ -614,6 +765,16 @@
       </object>
     </child>
   </object>
+  <object class="GtkImage" id="leftNbIcon">
+    <property name="visible">True</property>
+    <property name="can_focus">False</property>
+    <property name="stock">gtk-yes</property>
+  </object>
+  <object class="GtkImage" id="rightNbIcon">
+    <property name="visible">True</property>
+    <property name="can_focus">False</property>
+    <property name="stock">gtk-yes</property>
+  </object>
   <object class="GtkBox" id="viewBox">
     <property name="visible">True</property>
     <property name="can_focus">False</property>
@@ -623,24 +784,37 @@
         <property name="visible">True</property>
         <property name="can_focus">False</property>
         <child>
-          <object class="GtkEntry" id="urlBar">
+          <object class="GtkButton" id="backViewB">
             <property name="visible">True</property>
             <property name="can_focus">True</property>
-            <property name="input_purpose">url</property>
+            <property name="receives_default">True</property>
+            <child>
+              <object class="GtkImage" id="imageGoBack">
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <property name="stock">gtk-go-back</property>
+              </object>
+            </child>
           </object>
           <packing>
-            <property name="expand">True</property>
+            <property name="expand">False</property>
             <property name="fill">True</property>
+            <property name="padding">2</property>
             <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>
+            <child>
+              <object class="GtkImage" id="imageGoUp">
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <property name="stock">gtk-go-up</property>
+              </object>
+            </child>
           </object>
           <packing>
             <property name="expand">False</property>
@@ -650,26 +824,37 @@
           </packing>
         </child>
         <child>
-          <object class="GtkButton" id="homeViewB">
+          <object class="GtkButton" id="forwardViewB">
-            <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>
+            <child>
+              <object class="GtkImage" id="imageGoForward">
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <property name="stock">gtk-go-forward</property>
+              </object>
+            </child>
           </object>
           <packing>
             <property name="expand">False</property>
             <property name="fill">True</property>
+            <property name="padding">2</property>
             <property name="position">2</property>
           </packing>
         </child>
         <child>
           <object class="GtkButton" id="refreshViewB">
-            <property name="label">gtk-refresh</property>
             <property name="visible">True</property>
             <property name="can_focus">True</property>
             <property name="receives_default">True</property>
-            <property name="use_stock">True</property>
+            <child>
+              <object class="GtkImage" id="imageRefresh">
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <property name="stock">gtk-refresh</property>
+              </object>
+            </child>
           </object>
           <packing>
             <property name="expand">False</property>
@@ -678,6 +863,37 @@
             <property name="position">3</property>
           </packing>
         </child>
+        <child>
+          <object class="GtkButton" id="homeViewB">
+            <property name="visible">True</property>
+            <property name="can_focus">True</property>
+            <property name="receives_default">True</property>
+            <child>
+              <object class="GtkImage" id="imageHome">
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <property name="stock">gtk-home</property>
+              </object>
+            </child>
+          </object>
+          <packing>
+            <property name="expand">False</property>
+            <property name="fill">True</property>
+            <property name="position">4</property>
+          </packing>
+        </child>
+        <child>
+          <object class="GtkEntry" id="urlBar">
+            <property name="visible">True</property>
+            <property name="can_focus">True</property>
+            <property name="input_purpose">url</property>
+          </object>
+          <packing>
+            <property name="expand">True</property>
+            <property name="fill">True</property>
+            <property name="position">5</property>
+          </packing>
+        </child>
       </object>
       <packing>
         <property name="expand">False</property>
@@ -699,7 +915,7 @@
       <packing>
         <property name="expand">True</property>
         <property name="fill">True</property>
-        <property name="position">1</property>
+        <property name="position">2</property>
       </packing>
     </child>
   </object>

hacking/HACKING.md

@@ -61,6 +61,8 @@ This leads to the following benefits:
 * we can reason about filepaths and rely on them to be valid (don't confuse that with "they exist")
 * filepath functions like `(</>)` are now predictable and safe in contrast to the version from the `filepath` package
 
+The [hpath](https://hackage.haskell.org/package/hpath) library does exactly that for us.
+
 The only problem with this approach is that most libraries are still String
 based. Some provide dedicated `Foo.ByteString` modules though, but it
 might be necessary to fork libraries.
@@ -84,17 +86,10 @@ the call stack at point `b` in time, when the file information in memory
 could already be out of date. There are two approaches to make this less
 sucky:
 * use the hinotify library on GUI level to refresh the view (and the File representation in memory) whenever the contents of a directory changes
-* when we stuff something into the copy buffer, it is not saved as type `File a`, but as `Path Abs`... when the operation is finalized via `runFileOp`, then the file at the given path is read and the copy/move/whatnot function carried out immediately
+* when we stuff something into the copy buffer, it is not saved as type `File a`, but as `Path Abs`... when the operation is finalized  then the file at the given path is read and the copy/move/whatnot function carried out immediately
-
-This means we should only interact with the `HSFM.FileSystem.FileOperation`
-module via the operation data types `FileOperation`, `Copy` and `Move` and
-the `runFileOp` function. This doesn't completely solve the problem, but for
-the rest we have to trust the posix functions to throw the proper exceptions.
 
 In addition, we don't use the `directory` package, which is dangerous
-and broken. Instead, we implement our own low-level wrappers around
+and broken. Instead, we use the [HPath.IO](https://hackage.haskell.org/package/hpath/docs/HPath-IO.html).
-the posix functions, so we have proper control over the internals
-and know the possible exceptions.
 
 ### Exception handling
 
@@ -102,7 +97,7 @@ Exceptions are good. We don't want to wrap everything in Maybe/Either types
 unless we want to handle failure immediately. Otherwise we need to make
 sure that at least at some point IOExceptions are caught and visualized
 to the user. This is often done via e.g. `withErrorDialog` which catches
-`IOException` and `FmIOException`.
+`IOException` and [HPathIOException](https://hackage.haskell.org/package/hpath/docs/HPath-IO-Errors.html#t:HPathIOException).
 
 It's also important to clean up stuff like filedescriptors via
 functions like `bracket` directly in our low-level code in case

hsfm.cabal

@@ -10,7 +10,7 @@ copyright:           Copyright: (c) 2016 Julian Ospald
 homepage:            https://github.com/hasufell/hsfm
 category:            Desktop
 build-type:          Simple
-cabal-version:       >=1.10
+cabal-version:       >=1.22
 
 data-files:
                      LICENSE
@@ -26,16 +26,20 @@ library
   exposed-modules:
                        HSFM.FileSystem.FileType
                        HSFM.FileSystem.UtilTypes
+                       HSFM.History
+                       HSFM.Settings
                        HSFM.Utils.IO
                        HSFM.Utils.MyPrelude
 
   build-depends:
-                       base >= 4.7,
+                       IfElse,
+                       base >= 4.8 && < 5,
                        bytestring,
-                       data-default,
                        filepath >= 1.3.0.0,
                        hinotify-bytestring,
-                       hpath >= 0.7.1,
+                       hpath >= 0.11.0 ,
+                       hpath-filepath >= 0.10.3,
+                       hpath-io >= 0.12.0,
                        safe,
                        stm,
                        time >= 1.4.2,
@@ -48,14 +52,14 @@ library
                        FlexibleInstances
                        ViewPatterns
   ghc-options:
-    -O2
-    -threaded
     -Wall
-    "-with-rtsopts=-N"
 
 executable hsfm-gtk
   main-is:             HSFM/GUI/Gtk.hs
   other-modules:
+                       Paths_hsfm
+                       HSFM.FileSystem.FileType
+                       HSFM.FileSystem.UtilTypes
                        HSFM.GUI.Glib.GlibString
                        HSFM.GUI.Gtk.Callbacks
                        HSFM.GUI.Gtk.Callbacks.Utils
@@ -65,20 +69,28 @@ executable hsfm-gtk
                        HSFM.GUI.Gtk.Icons
                        HSFM.GUI.Gtk.MyGUI
                        HSFM.GUI.Gtk.MyView
+                       HSFM.GUI.Gtk.Plugins
+                       HSFM.GUI.Gtk.Settings
                        HSFM.GUI.Gtk.Utils
+                       HSFM.History
+                       HSFM.Settings
+                       HSFM.Utils.IO
                        HSFM.Utils.MyPrelude
 
   build-depends:
                        Cabal >= 1.22.0.0,
-                       base >= 4.7,
+                       IfElse,
+                       base >= 4.8 && < 5,
                        bytestring,
-                       data-default,
                        filepath >= 1.3.0.0,
                        glib >= 0.13,
                        gtk3 >= 0.14.1,
                        hinotify-bytestring,
-                       hpath >= 0.7.1,
+                       hpath >= 0.11.0 ,
+                       hpath-filepath >= 0.10.3,
+                       hpath-io >= 0.12.0,
                        hsfm,
+                       monad-loops,
                        old-locale >= 1,
                        process,
                        safe,
@@ -97,8 +109,9 @@ executable hsfm-gtk
                        FlexibleInstances
                        ViewPatterns
   ghc-options:
-    -O2
-    -threaded
     -Wall
-    "-with-rtsopts=-N"
+
+source-repository head
+  type:     git
+  location: https://github.com/hasufell/hsfm
 

install.sh

@@ -0,0 +1,42 @@
+#!/bin/sh
+
+set -eu
+
+SCRIPT_DIR="$(CDPATH="" cd -- "$(dirname -- "$0")" && pwd -P)"
+
+cd "${SCRIPT_DIR}"
+
+# install ghcup
+if ! [ -e "${SCRIPT_DIR}"/.ghcup/bin/ghcup ] ; then
+    mkdir -p "${SCRIPT_DIR}"/.ghcup/bin
+    curl --proto '=https' --tlsv1.2 -sSf https://gitlab.haskell.org/haskell/ghcup/raw/master/ghcup > "${SCRIPT_DIR}"/.ghcup/bin/ghcup
+    chmod +x "${SCRIPT_DIR}"/.ghcup/bin/ghcup
+fi
+
+# set up environment
+export PATH="${SCRIPT_DIR}/.ghcup/bin:$PATH"
+export GHCUP_INSTALL_BASE_PREFIX="${SCRIPT_DIR}"
+
+# get ghc version from cabal.project
+ghc_ver=$(grep with-compiler cabal.project | awk '{print $2}' | sed 's/ghc-//')
+
+# install ghc
+if ! ghcup list -t ghc -c installed -r | grep -q "${ghc_ver}" ; then
+    ghcup install "${ghc_ver}"
+fi
+
+# install cabal-install
+if [ -z "$(ghcup list -t cabal-install -c installed -r)" ] ; then
+    ghcup install-cabal
+fi
+
+[ -e "${SCRIPT_DIR}"/bin ] || mkdir "${SCRIPT_DIR}"/bin
+
+# install binary
+cabal v2-install \
+    --installdir="${SCRIPT_DIR}"/bin \
+    --install-method=copy \
+    --overwrite-policy=always
+
+echo "Binary installed in: ${SCRIPT_DIR}/bin"
+

src/HSFM/FileSystem/FileType.hs

@@ -42,7 +42,6 @@ import Data.ByteString.UTF8
   (
     toString
   )
-import Data.Default
 import Data.Time.Clock.POSIX
   (
     POSIXTime
@@ -57,13 +56,7 @@ import HPath
 import qualified HPath as P
 import HPath.IO hiding (FileType(..))
 import HPath.IO.Errors
-import HSFM.Utils.MyPrelude
 import Prelude hiding(readFile)
-import System.IO.Error
-  (
-    ioeGetErrorType
-  , isDoesNotExistErrorType
-  )
 import System.Posix.FilePath
   (
     (</>)
@@ -98,13 +91,9 @@ import System.Posix.Types
 -- |The String in the path field is always a full path.
 -- The free type variable is used in the File/Dir constructor and can hold
 -- Handles, Strings representing a file's contents or anything else you can
--- think of. We catch any IO errors in the Failed constructor.
+-- think of.
 data File a =
-    Failed {
+  Dir {
-    path :: !(Path Abs)
-  , err  :: IOError
-  }
-  | Dir {
     path :: !(Path Abs)
   , fvar :: a
   }
@@ -115,8 +104,8 @@ data File a =
   | SymLink {
     path    :: !(Path Abs)
   , fvar    :: a
-  , sdest   :: File a  -- ^ symlink madness,
+  , sdest   :: Maybe (File a)  -- ^ symlink madness,
-                       --   we need to know where it points to
+                               --   we need to know where it points to
   , rawdest :: !ByteString
   }
   | BlockDev {
@@ -187,28 +176,31 @@ fileLike f             = (False, f)
 
 
 sdir :: File FileInfo -> (Bool, File FileInfo)
-sdir f@SymLink{ sdest = (s@SymLink{} )}
+sdir f@SymLink{ sdest = (Just s@SymLink{} )}
   -- we have to follow a chain of symlinks here, but
   -- return only the very first level
   -- TODO: this is probably obsolete now
   = case sdir s of
       (True, _) -> (True, f)
       _         -> (False, f)
-sdir f@SymLink{ sdest = Dir{} }
+sdir f@SymLink{ sdest = Just Dir{} }
   = (True, f)
 sdir f@Dir{} = (True, f)
 sdir f       = (False, f)
 
 
 -- |Matches on any non-directory kind of files, excluding symlinks.
+pattern FileLike :: File FileInfo -> File FileInfo
 pattern FileLike  f <- (fileLike  -> (True, f))
 
 -- |Matches a list of directories or symlinks pointing to directories.
+pattern DirList :: [File FileInfo] -> [File FileInfo]
 pattern DirList fs <- (\fs -> (and . fmap (fst . sdir) $ fs, fs)
                                 -> (True, fs))
 
 -- |Matches a list of any non-directory kind of files or symlinks
 -- pointing to such.
+pattern FileLikeList :: [File FileInfo] -> [File FileInfo]
 pattern FileLikeList fs <- (\fs -> (and
                                      . fmap (fst . sfileLike)
                                      $ fs, fs) -> (True, fs))
@@ -223,31 +215,33 @@ brokenSymlink f = (isBrokenSymlink f, f)
 
 
 fileLikeSym :: File FileInfo -> (Bool, File FileInfo)
-fileLikeSym f@SymLink{ sdest = s@SymLink{} }
+fileLikeSym f@SymLink{ sdest = Just s@SymLink{} }
   = case fileLikeSym s of
       (True, _) -> (True, f)
       _         -> (False, f)
-fileLikeSym f@SymLink{ sdest = RegFile{} }   = (True, f)
+fileLikeSym f@SymLink{ sdest = Just RegFile{} }   = (True, f)
-fileLikeSym f@SymLink{ sdest = BlockDev{} }  = (True, f)
+fileLikeSym f@SymLink{ sdest = Just BlockDev{} }  = (True, f)
-fileLikeSym f@SymLink{ sdest = CharDev{} }   = (True, f)
+fileLikeSym f@SymLink{ sdest = Just CharDev{} }   = (True, f)
-fileLikeSym f@SymLink{ sdest = NamedPipe{} } = (True, f)
+fileLikeSym f@SymLink{ sdest = Just NamedPipe{} } = (True, f)
-fileLikeSym f@SymLink{ sdest = Socket{} }    = (True, f)
+fileLikeSym f@SymLink{ sdest = Just Socket{} }    = (True, f)
 fileLikeSym f                                = (False, f)
 
 
 dirSym :: File FileInfo -> (Bool, File FileInfo)
-dirSym f@SymLink{ sdest = s@SymLink{} }
+dirSym f@SymLink{ sdest = Just s@SymLink{} }
   = case dirSym s of
       (True, _) -> (True, f)
       _         -> (False, f)
-dirSym f@SymLink{ sdest = Dir{} } = (True, f)
+dirSym f@SymLink{ sdest = Just Dir{} } = (True, f)
 dirSym f = (False, f)
 
 
 -- |Matches on symlinks pointing to file-like files only.
+pattern FileLikeSym :: File FileInfo -> File FileInfo
 pattern FileLikeSym  f <- (fileLikeSym  -> (True, f))
 
 -- |Matches on broken symbolic links.
+pattern BrokenSymlink :: File FileInfo -> File FileInfo
 pattern BrokenSymlink  f <- (brokenSymlink  -> (True, f))
 
 
@@ -255,9 +249,11 @@ pattern BrokenSymlink  f <- (brokenSymlink  -> (True, f))
 -- If the symlink is pointing to a symlink pointing to a directory, then
 -- it will return True, but also return the first element in the symlink-
 -- chain, not the last.
+pattern DirOrSym :: File FileInfo -> File FileInfo
 pattern DirOrSym  f <- (sdir  -> (True, f))
 
 -- |Matches on symlinks pointing to directories only.
+pattern DirSym :: File FileInfo -> File FileInfo
 pattern DirSym   f <- (dirSym  -> (True, f))
 
 -- |Matches on any non-directory kind of files or symlinks pointing to
@@ -265,6 +261,7 @@ pattern DirSym   f <- (dirSym  -> (True, f))
 -- If the symlink is pointing to a symlink pointing to such a file, then
 -- it will return True, but also return the first element in the symlink-
 -- chain, not the last.
+pattern FileLikeOrSym :: File FileInfo -> File FileInfo
 pattern FileLikeOrSym  f <- (sfileLike  -> (True, f))
 
 
@@ -303,11 +300,10 @@ instance Ord (File FileInfo) where
 
 -- |Reads a file or directory Path into an `AnchoredFile`, filling the free
 -- variables via the given function.
-readFile :: (Path Abs -> IO a)
+pathToFile :: (Path Abs -> IO a)
-         -> Path Abs
+           -> Path Abs
-         -> IO (File a)
+           -> IO (File a)
-readFile ff p =
+pathToFile ff p = do
-  handleDT p $ do
     fs   <- PF.getSymbolicLinkStatus (P.toFilePath p)
     fv   <- ff p
     constructFile fs fv p
@@ -317,11 +313,12 @@ readFile ff p =
           -- symlink madness, we need to make sure we save the correct
           -- File
           x <- PF.readSymbolicLink (P.fromAbs p')
-          resolvedSyml <- handleDT p' $ do
+          resolvedSyml <- handleIOError (\_ -> return Nothing) $ do
             -- watch out, we call </> from 'filepath' here, but it is safe
             let sfp = (P.fromAbs . P.dirname $ p') </> x
             rsfp <- realpath sfp
-            readFile ff =<< P.parseAbs rsfp
+            f <- pathToFile ff =<< P.parseAbs rsfp
+            return $ Just f
           return $ SymLink p' fv resolvedSyml x
       | PF.isDirectory       fs = return $ Dir       p' fv
       | PF.isRegularFile     fs = return $ RegFile   p' fv
@@ -329,8 +326,7 @@ readFile ff p =
       | PF.isCharacterDevice fs = return $ CharDev   p' fv
       | PF.isNamedPipe       fs = return $ NamedPipe p' fv
       | PF.isSocket          fs = return $ Socket    p' fv
-      | otherwise               = return $ Failed    p' (userError
+      | otherwise               = ioError $ userError "Unknown filetype!"
-                                                         "Unknown filetype!")
 
 
 -- |Get the contents of a given directory and return them as a list
@@ -340,8 +336,7 @@ readDirectoryContents :: (Path Abs -> IO a)  -- ^ fills free a variable
                       -> IO [File a]
 readDirectoryContents ff p = do
   files <- getDirsFiles p
-  fcs   <- mapM (readFile ff) files
+  mapM (pathToFile ff) files
-  return fcs
 
 
 -- |A variant of `readDirectoryContents` where the second argument
@@ -357,12 +352,12 @@ getContents _ _ = return []
 
 -- |Go up one directory in the filesystem hierarchy.
 goUp :: File FileInfo -> IO (File FileInfo)
-goUp file = readFile getFileInfo (P.dirname . path $ file)
+goUp file = pathToFile getFileInfo (P.dirname . path $ file)
 
 
 -- |Go up one directory in the filesystem hierarchy.
 goUp' :: Path Abs -> IO (File FileInfo)
-goUp' fp = readFile getFileInfo $ P.dirname fp
+goUp' fp = pathToFile getFileInfo $ P.dirname fp
 
 
 
@@ -373,28 +368,6 @@ goUp' fp = readFile getFileInfo $ P.dirname fp
 
 
 
----- HANDLING FAILURES ----
-
-
--- |True if any Failed constructors in the tree.
-anyFailed :: [File a] -> Bool
-anyFailed = not . successful
-
--- |True if there are no Failed constructors in the tree.
-successful :: [File a] -> Bool
-successful = null . failures
-
-
--- |Returns true if argument is a `Failed` constructor.
-failed :: File a -> Bool
-failed (Failed _ _) = True
-failed _            = False
-
-
--- |Returns a list of 'Failed' constructors only.
-failures :: [File a] -> [File a]
-failures = filter failed
-
 
 
 ---- ORDERING AND EQUALITY ----
@@ -402,11 +375,7 @@ failures = filter failed
 
  -- HELPER: a non-recursive comparison
 comparingConstr :: File FileInfo -> File FileInfo -> Ordering
-comparingConstr (Failed _ _)      (DirOrSym _)      = LT
-comparingConstr (Failed _ _)      (FileLikeOrSym _) = LT
-comparingConstr (FileLikeOrSym _) (Failed _ _)      = GT
 comparingConstr (FileLikeOrSym _) (DirOrSym _)      = GT
-comparingConstr (DirOrSym _)      (Failed _ _)      = GT
 comparingConstr (DirOrSym _)      (FileLikeOrSym _) = LT
  -- else compare on the names of constructors that are the same, without
  -- looking at the contents of Dir constructors:
@@ -466,8 +435,6 @@ isSocketC _        = False
 
 
 
-
-
 -- |Gets all file information.
 getFileInfo :: Path Abs -> IO FileInfo
 getFileInfo fp = do
@@ -490,17 +457,6 @@ getFileInfo fp = do
 
 
 
----- FAILURE HELPERS: ----
-
-
--- Handles an IO exception by returning a Failed constructor filled with that
--- exception. Does not handle FmIOExceptions.
-handleDT :: Path Abs
-         -> IO (File a)
-         -> IO (File a)
-handleDT p
-  = handleIOError $ \e -> return $ Failed p e
-
 
 
 ---- SYMLINK HELPERS: ----
@@ -511,7 +467,7 @@ handleDT p
 --
 -- When called on a non-symlink, returns False.
 isBrokenSymlink :: File FileInfo -> Bool
-isBrokenSymlink (SymLink _ _ Failed{} _) = True
+isBrokenSymlink (SymLink _ _ Nothing _) = True
 isBrokenSymlink _ = False
 
 
@@ -523,13 +479,13 @@ isBrokenSymlink _ = False
 -- |Pack the modification time into a string.
 packModTime :: File FileInfo
             -> String
-packModTime = fromFreeVar $ epochToString . modificationTime
+packModTime = epochToString . modificationTime . fvar
 
 
 -- |Pack the modification time into a string.
 packAccessTime :: File FileInfo
                -> String
-packAccessTime = fromFreeVar $ epochToString . accessTime
+packAccessTime = epochToString . accessTime . fvar
 
 
 epochToString :: EpochTime -> String
@@ -539,12 +495,12 @@ epochToString =  show . posixSecondsToUTCTime . realToFrac
 -- |Pack the permissions into a string, similar to what "ls -l" does.
 packPermissions :: File FileInfo
                 -> String
-packPermissions dt = fromFreeVar (pStr . fileMode) dt
+packPermissions file = (pStr . fileMode) . fvar $ file
   where
     pStr :: FileMode -> String
     pStr ffm = typeModeStr ++ ownerModeStr ++ groupModeStr ++ otherModeStr
       where
-        typeModeStr = case dt of
+        typeModeStr = case file of
           Dir {}       -> "d"
           RegFile {}   -> "-"
           SymLink {}   -> "l"
@@ -552,7 +508,6 @@ packPermissions dt = fromFreeVar (pStr . fileMode) dt
           CharDev {}   -> "c"
           NamedPipe {} -> "p"
           Socket {}    -> "s"
-          _            -> "?"
         ownerModeStr =    hasFmStr PF.ownerReadMode    "r"
                        ++ hasFmStr PF.ownerWriteMode   "w"
                        ++ hasFmStr PF.ownerExecuteMode "x"
@@ -577,7 +532,6 @@ packFileType file = case file of
   CharDev {}   -> "Char Device"
   NamedPipe {} -> "Named Pipe"
   Socket {}    -> "Socket"
-  _            -> "Unknown"
 
 
 packLinkDestination :: File a -> Maybe ByteString
@@ -591,24 +545,6 @@ packLinkDestination file = case file of
 ---- OTHER: ----
 
 
--- |Apply a function on the free variable. If there is no free variable
--- for the given constructor the value from the `Default` class is used.
-fromFreeVar :: (Default d) => (a -> d) -> File a -> d
-fromFreeVar f df = maybeD f $ getFreeVar df
-
-
 getFPasStr :: File a -> String
 getFPasStr = toString . P.fromAbs . path
 
-
--- |Gets the free variable. Returns Nothing if the constructor is of `Failed`.
-getFreeVar :: File a -> Maybe a
-getFreeVar (Dir _  d)         = Just d
-getFreeVar (RegFile _  d)     = Just d
-getFreeVar (SymLink _  d _ _) = Just d
-getFreeVar (BlockDev _  d)    = Just d
-getFreeVar (CharDev _  d)     = Just d
-getFreeVar (NamedPipe _  d)   = Just d
-getFreeVar (Socket _  d)      = Just d
-getFreeVar _                  = Nothing
-

src/HSFM/FileSystem/UtilTypes.hs

@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 
@@ -48,7 +47,7 @@ import HPath
   (
     Path
   , Abs
-  , Fn
+  , Rel
   )
 
 
@@ -80,5 +79,5 @@ data FCollisonMode = Strict  -- ^ fail if the target already exists
                    | Overwrite
                    | OverwriteAll
                    | Skip
-                   | Rename (Path Fn)
+                   | Rename (Path Rel)
 

src/HSFM/GUI/Glib/GlibString.hs

@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 
@@ -67,7 +66,7 @@ instance GlibString BS.ByteString where
     newUTFStringLen = newUTFStringLen . toString
     genUTFOfs = genUTFOfs . toString
     stringLength = BS.length
-    unPrintf s = BS.intercalate "%%" (BS.split _percent s)
+    unPrintf s = BS.intercalate (BS.pack [_percent, _percent]) (BS.split _percent s)
 
 
 foreign import ccall unsafe "string.h strlen" c_strlen

src/HSFM/GUI/Gtk.hs

@@ -16,40 +16,52 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 module Main where
 
 
+import qualified Data.ByteString as BS
 import Data.Maybe
   (
     fromJust
   , fromMaybe
   )
+import Data.Word8
 import Graphics.UI.Gtk
 import qualified HPath as P
+import HSFM.FileSystem.FileType
 import HSFM.GUI.Gtk.Callbacks
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.MyGUI
 import HSFM.GUI.Gtk.MyView
+import Prelude hiding(readFile)
 import Safe
   (
     headDef
   )
+import System.IO.Error
+  (
+    catchIOError
+  )
 import qualified System.Posix.Env.ByteString as SPE
 
+slash :: BS.ByteString
+slash = BS.singleton _slash
 
 main :: IO ()
 main = do
-  _ <- initGUI
-
   args <- SPE.getArgs
-  let mdir = fromMaybe (fromJust $ P.parseAbs "/")
+  let mdir = fromMaybe (fromJust $ P.parseAbs slash)
-                       (P.parseAbs . headDef "/" $ args)
+                       (P.parseAbs . headDef slash $ args)
 
+  file <- catchIOError (pathToFile getFileInfo mdir) $
+    \_ -> pathToFile getFileInfo  . fromJust $ P.parseAbs slash
+
+  _ <- initGUI
   mygui <- createMyGUI
-  _ <- newTab mygui createTreeView mdir
+  _ <- newTab mygui (notebook1 mygui) createTreeView file (-1)
+  _ <- newTab mygui (notebook2 mygui) createTreeView file (-1)
 
   setGUICallbacks mygui
 

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -16,7 +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 OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 module HSFM.GUI.Gtk.Callbacks where
@@ -32,14 +32,21 @@ import Control.Exception
   )
 import Control.Monad
   (
-    forM_
+    forM
+  , forM_
+  , join
   , void
   , when
   )
+import Control.Monad.IfElse
 import Control.Monad.IO.Class
   (
     liftIO
   )
+import Control.Monad.Loops
+  (
+    iterateUntil
+  )
 import Data.ByteString
   (
     ByteString
@@ -56,36 +63,45 @@ import Data.Foldable
 import Graphics.UI.Gtk
 import qualified HPath as P
 import HPath
-    (
+  (
-      Abs
+    fromAbs
-    , Path
+  , Abs
-    )
+  , Path
+  )
 import HPath.IO
 import HPath.IO.Errors
-import HPath.IO.Utils
 import HSFM.FileSystem.FileType
 import HSFM.FileSystem.UtilTypes
 import HSFM.GUI.Gtk.Callbacks.Utils
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Dialogs
 import HSFM.GUI.Gtk.MyView
+import HSFM.GUI.Gtk.Plugins
+import HSFM.GUI.Gtk.Settings
 import HSFM.GUI.Gtk.Utils
+import HSFM.History
+import HSFM.Settings
 import HSFM.Utils.IO
 import Prelude hiding(readFile)
 import System.Glib.UTFString
   (
     glibToString
   )
-import System.Posix.Env.ByteString
-  (
-    getEnv
-  )
 import qualified System.Posix.Process.ByteString as SPP
 import System.Posix.Types
   (
     ProcessID
   )
-
+import Control.Concurrent.MVar
+  (
+    putMVar
+  , readMVar
+  , takeMVar
+  )
+import Paths_hsfm
+  (
+    getDataFileName
+  )
 
 
 
@@ -104,6 +120,18 @@ import System.Posix.Types
 setGUICallbacks :: MyGUI -> IO ()
 setGUICallbacks mygui = do
 
+  -- notebook toggle buttons
+  _ <- leftNbBtn mygui `on` toggled $ do
+    isPressed <- toggleButtonGetActive $ leftNbBtn mygui
+    if isPressed then widgetShow $ notebook1 mygui
+                 else widgetHide $ notebook1 mygui
+
+  _ <- rightNbBtn mygui `on` toggled $ do
+    isPressed <- toggleButtonGetActive $ rightNbBtn mygui
+    if isPressed then widgetShow $ notebook2 mygui
+                 else widgetHide $ notebook2 mygui
+
+  -- statusbar
   _ <- clearStatusBar mygui `on` buttonActivated $ do
        popStatusbar mygui
        writeTVarIO (operationBuffer mygui) None
@@ -119,8 +147,8 @@ setGUICallbacks mygui = do
 
   -- key events
   _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
-    [Control] <- eventModifier
+    QuitModifier <- eventModifier
-    "q"       <- fmap glibToString eventKeyName
+    QuitKey      <- fmap glibToString eventKeyName
     liftIO mainQuit
 
   return ()
@@ -175,7 +203,45 @@ setViewCallbacks mygui myview = do
     commonGuiEvents fmv = do
       let view = fmViewToContainer fmv
 
+      -- focus events
+      _ <- notebook1 mygui `on` setFocusChild $ \w ->
+        case w of
+             Nothing -> widgetSetSensitive (leftNbIcon mygui) False
+             _       -> widgetSetSensitive (leftNbIcon mygui) True
+      _ <- notebook2 mygui `on` setFocusChild $ \w ->
+        case w of
+             Nothing -> widgetSetSensitive (rightNbIcon mygui) False
+             _       -> widgetSetSensitive (rightNbIcon mygui) True
+
       -- GUI events
+      _ <- backViewB myview `on` buttonPressEvent $ do
+        eb <- eventButton
+        t  <- eventTime
+        case eb of
+          LeftButton  -> do
+            liftIO $ void $ goHistoryBack mygui myview
+            return True
+          RightButton -> do
+            his <- liftIO $ readMVar (history myview)
+            menu <- liftIO $ mkHistoryMenuB mygui myview
+                               (backwardsHistory his)
+            _ <- liftIO $ menuPopup menu $ Just (RightButton, t)
+            return True
+          _           -> return False
+      _ <- forwardViewB myview `on` buttonPressEvent $ do
+        eb <- eventButton
+        t  <- eventTime
+        case eb of
+          LeftButton  -> do
+            liftIO $ void $ goHistoryForward mygui myview
+            return True
+          RightButton -> do
+            his <- liftIO $ readMVar (history myview)
+            menu <- liftIO $ mkHistoryMenuF mygui myview
+                               (forwardHistory his)
+            _ <- liftIO $ menuPopup menu $ Just (RightButton, t)
+            return True
+          _           -> return False
       _ <- urlBar myview `on` entryActivated $ urlGoTo mygui myview
       _ <- upViewB myview `on` buttonActivated $
            upDir mygui myview
@@ -183,69 +249,68 @@ setViewCallbacks mygui myview = do
            goHome mygui myview
       _ <- refreshViewB myview `on` buttonActivated $ do
            cdir <- liftIO $ getCurrentDir myview
-           refreshView' mygui myview cdir
+           refreshView mygui myview cdir
 
       -- key events
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        ShowHiddenModifier <- eventModifier
-        "h"       <- fmap glibToString eventKeyName
+        ShowHiddenKey      <- fmap glibToString eventKeyName
         cdir <- liftIO $ getCurrentDir myview
         liftIO $ modifyTVarIO (settings mygui)
                               (\x -> x { showHidden = not . showHidden $ x})
-                 >> refreshView' mygui myview cdir
+                 >> refreshView mygui myview cdir
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Alt] <- eventModifier
+        UpDirModifier <- eventModifier
-        "Up"  <- fmap glibToString eventKeyName
+        UpDirKey      <- fmap glibToString eventKeyName
         liftIO $ upDir mygui myview
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Alt] <- eventModifier
+        HistoryBackModifier <- eventModifier
-        "Left"  <- fmap glibToString eventKeyName
+        HistoryBackKey      <- fmap glibToString eventKeyName
-        liftIO $ goHistoryPrev mygui myview
+        liftIO $ void $ goHistoryBack mygui myview
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Alt] <- eventModifier
+        HistoryForwardModifier <- eventModifier
-        "Right"  <- fmap glibToString eventKeyName
+        HistoryForwardKey      <- fmap glibToString eventKeyName
-        liftIO $ goHistoryNext mygui myview
+        liftIO $ void $ goHistoryForward mygui myview
       _ <- view `on` keyPressEvent $ tryEvent $ do
-        "Delete"  <- fmap glibToString eventKeyName
+        DeleteModifier <- eventModifier
+        DeleteKey      <- fmap glibToString eventKeyName
         liftIO $ withItems mygui myview del
       _ <- view `on` keyPressEvent $ tryEvent $ do
-        []            <- eventModifier
+        OpenModifier <- eventModifier
-        "Return"      <- fmap glibToString eventKeyName
+        OpenKey      <- fmap glibToString eventKeyName
         liftIO $ withItems mygui myview open
       _ <- view `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        CopyModifier <- eventModifier
-        "c"       <- fmap glibToString eventKeyName
+        CopyKey      <- fmap glibToString eventKeyName
         liftIO $ withItems mygui myview copyInit
       _ <- view `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        MoveModifier <- eventModifier
-        "x"       <- fmap glibToString eventKeyName
+        MoveKey      <- fmap glibToString eventKeyName
         liftIO $ withItems mygui myview moveInit
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        PasteModifier <- eventModifier
-        "v"       <- fmap glibToString eventKeyName
+        PasteKey      <- fmap glibToString eventKeyName
         liftIO $ operationFinal mygui myview Nothing
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        NewTabModifier <- eventModifier
-        "t"       <- fmap glibToString eventKeyName
+        NewTabKey      <- fmap glibToString eventKeyName
-        liftIO $ void $ do
+        liftIO $ void $ newTab' mygui myview
-          cwd <- getCurrentDir myview
-          newTab mygui createTreeView (path cwd)
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        CloseTabModifier <- eventModifier
-        "w"       <- fmap glibToString eventKeyName
+        CloseTabKey      <- fmap glibToString eventKeyName
         liftIO $ void $ closeTab mygui myview
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        "F4"       <- fmap glibToString eventKeyName
+        OpenTerminalModifier <- eventModifier
+        OpenTerminalKey      <- fmap glibToString eventKeyName
         liftIO $ void $ openTerminalHere myview
 
-      -- righ-click
+      -- mouse button click
       _ <- view `on` buttonPressEvent $ do
         eb <- eventButton
         t  <- eventTime
         case eb of
           RightButton -> do
-              _ <- liftIO $ menuPopup (rcMenu . rcmenu $ myview)
+              _ <- liftIO $ showPopup mygui myview t
-                          $ Just (RightButton, t)
               -- this is just to not screw with current selection
               -- on right-click
               -- TODO: this misbehaves under IconView
@@ -260,42 +325,32 @@ setViewCallbacks mygui myview = do
                   return $ elem tp selectedTps
                 -- no item under the cursor, pass on the signal
                 Nothing -> return False
+          MiddleButton -> do
+            (x, y) <- eventCoordinates
+            mitem  <- liftIO $ (getPathAtPos fmv (x, y))
+                               >>= \mpos -> fmap join
+                                 $ forM mpos (rawPathToItem myview)
+
+            case mitem of
+              -- item under the cursor, only pass on the signal
+              -- if the item under the cursor is not within the current
+              -- selection
+              (Just item) -> do
+                liftIO $ opeInNewTab mygui myview item
+                return True
+              -- no item under the cursor, pass on the signal
+              Nothing -> return False
+
           OtherButton 8 -> do
-            liftIO $ goHistoryPrev mygui myview
+            liftIO $ void $ goHistoryBack mygui myview
             return False
           OtherButton 9 -> do
-            liftIO $ goHistoryNext mygui myview
+            liftIO $ void $ goHistoryForward mygui myview
             return False
           -- not right-click, so pass on the signal
           _ -> return False
 
-      -- right click menu
-      _ <- (rcFileOpen . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview open
-      _ <- (rcFileExecute . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview execute
-      _ <- (rcFileNewRegFile . rcmenu) myview `on` menuItemActivated $
-        liftIO $ newFile mygui myview
-      _ <- (rcFileNewDir . rcmenu) myview `on` menuItemActivated $
-        liftIO $ newDir mygui myview
-      _ <- (rcFileCopy . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview copyInit
-      _ <- (rcFileRename . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview renameF
-      _ <- (rcFilePaste . rcmenu) myview `on` menuItemActivated $
-        liftIO $ operationFinal mygui myview Nothing
-      _ <- (rcFileDelete . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview del
-      _ <- (rcFileProperty . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview showFilePropertyDialog
-      _ <- (rcFileCut . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview moveInit
-      _ <- (rcFileIconView . rcmenu) myview `on` menuItemActivated $
-        liftIO $ switchView mygui myview createIconView
-      _ <- (rcFileTreeView . rcmenu) myview `on` menuItemActivated $
-        liftIO $ switchView mygui myview createTreeView
       return ()
-
     getPathAtPos fmv (x, y) =
       case fmv of
         FMTreeView treeView -> do
@@ -314,8 +369,7 @@ setViewCallbacks mygui myview = do
 openTerminalHere :: MyView -> IO ProcessID
 openTerminalHere myview = do
   cwd <- (P.fromAbs . path) <$> getCurrentDir myview
-  -- TODO: make terminal configurable
+  SPP.forkProcess $ terminalCommand cwd
-  SPP.forkProcess $ SPP.executeFile "sakura" True ["-d", cwd] Nothing
 
 
 
@@ -325,9 +379,23 @@ openTerminalHere myview = do
 
 -- |Closes the current tab, but only if there is more than one tab.
 closeTab :: MyGUI -> MyView -> IO ()
-closeTab mygui myview = do
+closeTab _ myview = do
-  n <- notebookGetNPages (notebook mygui)
+  n <- notebookGetNPages (notebook myview)
-  when (n > 1) $ void $ destroyView mygui myview
+  when (n > 1) $ void $ destroyView myview
+
+
+newTab' :: MyGUI -> MyView -> IO ()
+newTab' mygui myview = do
+  cwd <- getCurrentDir myview
+  void $ withErrorDialog
+       $ newTab mygui (notebook myview) createTreeView cwd (-1)
+
+
+opeInNewTab :: MyGUI -> MyView -> Item -> IO ()
+opeInNewTab mygui myview item@(DirOrSym _) =
+  void $ withErrorDialog
+       $ newTab mygui (notebook myview) createTreeView item (-1)
+opeInNewTab _ _ _ = return ()
 
 
 
@@ -346,7 +414,7 @@ del items@(_:_) _ _ = withErrorDialog $ do
   withConfirmationDialog cmsg
     $ forM_ items $ \item -> easyDelete . path $ item
 del _ _ _ = withErrorDialog
-              . throwIO $ InvalidOperation
+              . ioError $ userError
                           "Operation not supported on multiple files"
 
 
@@ -361,7 +429,7 @@ moveInit items@(_:_) mygui _ = do
   popStatusbar mygui
   void $ pushStatusBar mygui sbmsg
 moveInit _ _ _ = withErrorDialog
-                   . throwIO $ InvalidOperation
+                   . ioError $ userError
                                "No file selected!"
 
 -- |Supposed to be used with 'withRows'. Initializes a file copy operation.
@@ -375,7 +443,7 @@ copyInit items@(_:_) mygui _ = do
   popStatusbar mygui
   void $ pushStatusBar mygui sbmsg
 copyInit _ _ _ = withErrorDialog
-                   . throwIO $ InvalidOperation
+                   . ioError $ userError
                                "No file selected!"
 
 
@@ -410,27 +478,27 @@ operationFinal mygui myview mitem = withErrorDialog $ do
 newFile :: MyGUI -> MyView -> IO ()
 newFile _ myview = withErrorDialog $ do
   mfn   <- textInputDialog "Enter file name" ("" :: String)
-  let pmfn = P.parseFn =<< fromString <$> mfn
+  let pmfn = P.parseRel =<< fromString <$> mfn
   for_ pmfn $ \fn -> do
     cdir  <- getCurrentDir myview
-    createRegularFile (path cdir P.</> fn)
+    createRegularFile newFilePerms (path cdir P.</> fn)
 
 
 -- |Create a new directory.
 newDir :: MyGUI -> MyView -> IO ()
 newDir _ myview = withErrorDialog $ do
   mfn   <- textInputDialog "Enter directory name" ("" :: String)
-  let pmfn = P.parseFn =<< fromString <$> mfn
+  let pmfn = P.parseRel =<< fromString <$> mfn
   for_ pmfn $ \fn -> do
     cdir  <- getCurrentDir myview
-    createDir (path cdir P.</> fn)
+    createDir newDirPerms (path cdir P.</> fn)
 
 
 renameF :: [Item] -> MyGUI -> MyView -> IO ()
 renameF [item] _ _ = withErrorDialog $ do
   iname <- P.fromRel <$> (P.basename $ path item)
   mfn  <- textInputDialog "Enter new file name" (iname :: ByteString)
-  let pmfn = P.parseFn =<< fromString <$> mfn
+  let pmfn = P.parseRel =<< fromString <$> mfn
   for_ pmfn $ \fn -> do
     let cmsg = "Really rename \"" ++ getFPasStr item
                ++ "\"" ++ " to \""
@@ -440,7 +508,7 @@ renameF [item] _ _ = withErrorDialog $ do
       HPath.IO.renameFile (path item)
                           ((P.dirname $ path item) P.</> fn)
 renameF _ _ _ = withErrorDialog
-                  . throwIO $ InvalidOperation
+                  . ioError $ userError
                               "Operation not supported on multiple files"
 
 
@@ -458,15 +526,15 @@ urlGoTo mygui myview = withErrorDialog $ do
   fp <- entryGetText (urlBar myview)
   forM_ (P.parseAbs fp :: Maybe (Path Abs)) $ \fp' ->
       whenM (canOpenDirectory fp')
-            (goDir mygui myview =<< (readFile getFileInfo $ fp'))
+            (goDir True mygui myview =<< (pathToFile getFileInfo $ fp'))
 
 
 goHome :: MyGUI -> MyView -> IO ()
 goHome mygui myview =  withErrorDialog $ do
-  mhomedir <- getEnv "HOME"
+  homedir <- home
-  forM_ (P.parseAbs =<< mhomedir :: Maybe (Path Abs)) $ \fp' ->
+  forM_ (P.parseAbs homedir :: Maybe (Path Abs)) $ \fp' ->
       whenM (canOpenDirectory fp')
-            (goDir mygui myview =<< (readFile getFileInfo $ fp'))
+            (goDir True mygui myview =<< (pathToFile getFileInfo $ fp'))
 
 
 -- |Execute a given file.
@@ -474,7 +542,7 @@ execute :: [Item] -> MyGUI -> MyView -> IO ()
 execute [item] _ _ = withErrorDialog $
   void $ executeFile (path item) []
 execute _ _ _ = withErrorDialog
-                  . throwIO $ InvalidOperation
+                  . ioError $ userError
                               "Operation not supported on multiple files"
 
 
@@ -483,16 +551,15 @@ open :: [Item] -> MyGUI -> MyView -> IO ()
 open [item] mygui myview = withErrorDialog $
   case item of
     DirOrSym r -> do
-      nv <- readFile getFileInfo $ path r
+      nv <- pathToFile getFileInfo $ path r
-      goDir mygui myview nv
+      goDir True mygui myview nv
     r ->
       void $ openFile . path $ r
--- this throws on the first error that occurs
+open items mygui myview = do
-open (FileLikeList fs) _ _ = withErrorDialog $
+  let dirs  = filter (fst . sdir) items
-  forM_ fs $ \f -> void $ openFile . path $ f
+      files = filter (fst . sfileLike) items
-open _ _ _ = withErrorDialog
+  forM_ dirs (withErrorDialog . opeInNewTab mygui myview)
-               . throwIO $ InvalidOperation
+  forM_ files (withErrorDialog . openFile . path)
-                           "Operation not supported on multiple files"
 
 
 -- |Go up one directory and visualize it in the treeView.
@@ -500,33 +567,162 @@ upDir :: MyGUI -> MyView -> IO ()
 upDir mygui myview = withErrorDialog $ do
   cdir <- getCurrentDir myview
   nv <- goUp cdir
-  goDir mygui myview nv
+  goDir True mygui myview nv
+
+
+
+
+---- HISTORY CALLBACKS ----
 
 
 -- |Go "back" in the history.
-goHistoryPrev :: MyGUI -> MyView -> IO ()
+goHistoryBack :: MyGUI -> MyView -> IO (Path Abs)
-goHistoryPrev mygui myview = do
+goHistoryBack mygui myview = do
-  hs <- readTVarIO (history myview)
+  hs <- takeMVar (history myview)
-  case hs of
+  let nhs = historyBack hs
-    ([], _) -> return ()
+  putMVar (history myview) nhs
-    (x:xs, _) -> do
+  nv <- pathToFile getFileInfo $ currentDir nhs
-      cdir <- getCurrentDir myview
+  goDir False mygui myview nv
-      nv <- readFile getFileInfo $ x
+  return $ currentDir nhs
-      modifyTVarIO (history myview)
-        (\(_, n) -> (xs, path cdir `addHistory` n))
-      refreshView' mygui myview nv
 
 
--- |Go "forth" in the history.
+-- |Go "forward" in the history.
-goHistoryNext :: MyGUI -> MyView -> IO ()
+goHistoryForward :: MyGUI -> MyView -> IO (Path Abs)
-goHistoryNext mygui myview = do
+goHistoryForward mygui myview = do
-  hs <- readTVarIO (history myview)
+  hs <- takeMVar (history myview)
-  case hs of
+  let nhs = historyForward hs
-    (_, []) -> return ()
+  putMVar (history myview) nhs
-    (_, x:xs) -> do
+  nv <- pathToFile getFileInfo $ currentDir nhs
-      cdir <- getCurrentDir myview
+  goDir False mygui myview nv
-      nv <- readFile getFileInfo $ x
+  return $ currentDir nhs
-      modifyTVarIO (history myview)
+
-        (\(p, _) -> (path cdir `addHistory` p, xs))
+
-      refreshView' mygui myview nv
+-- |Show backwards history in a drop-down menu, depending on the input.
+mkHistoryMenuB :: MyGUI -> MyView -> [Path Abs] -> IO Menu
+mkHistoryMenuB mygui myview hs = do
+  menu <- menuNew
+  menuitems <- forM hs $ \p -> do
+    item <- menuItemNewWithLabel (fromAbs p)
+    _ <- item `on` menuItemActivated $
+      void $ iterateUntil (== p) (goHistoryBack mygui myview)
+    return item
+  forM_ menuitems $ \item -> menuShellAppend menu item
+  widgetShowAll menu
+  return menu
+
+
+-- |Show forward history in a drop-down menu, depending on the input.
+mkHistoryMenuF :: MyGUI -> MyView -> [Path Abs] -> IO Menu
+mkHistoryMenuF mygui myview hs = do
+  menu <- menuNew
+  menuitems <- forM hs $ \p -> do
+    item <- menuItemNewWithLabel (fromAbs p)
+    _ <- item `on` menuItemActivated $
+      void $ iterateUntil (== p) (goHistoryForward mygui myview)
+    return item
+  forM_ menuitems $ \item -> menuShellAppend menu item
+  widgetShowAll menu
+  return menu
+
+
+
+
+---- RIGHTCLICK CALLBACKS ----
+
+
+-- |TODO: hopefully this does not leak
+showPopup :: MyGUI -> MyView -> TimeStamp -> IO ()
+showPopup mygui myview t
+  | null myplugins = return ()
+  | otherwise = do
+
+    rcmenu <- doRcMenu
+
+    -- add common callbacks
+    _ <- (\_ -> rcFileOpen rcmenu) myview `on` menuItemActivated $
+      liftIO $ withItems mygui myview open
+    _ <- (rcFileExecute rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview execute
+    _ <- (rcFileNewRegFile rcmenu) `on` menuItemActivated $
+      liftIO $ newFile mygui myview
+    _ <- (rcFileNewDir rcmenu) `on` menuItemActivated $
+      liftIO $ newDir mygui myview
+    _ <- (rcFileNewTab rcmenu) `on` menuItemActivated $
+      liftIO $ newTab' mygui myview
+    _ <- (rcFileNewTerm rcmenu) `on` menuItemActivated $
+      liftIO $ void $ openTerminalHere myview
+    _ <- (rcFileCopy rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview copyInit
+    _ <- (rcFileRename rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview renameF
+    _ <- (rcFilePaste rcmenu) `on` menuItemActivated $
+      liftIO $ operationFinal mygui myview Nothing
+    _ <- (rcFileDelete rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview del
+    _ <- (rcFileProperty rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview showFilePropertyDialog
+    _ <- (rcFileCut rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview moveInit
+    _ <- (rcFileIconView rcmenu) `on` menuItemActivated $
+      liftIO $ switchView mygui myview createIconView
+    _ <- (rcFileTreeView rcmenu) `on` menuItemActivated $
+      liftIO $ switchView mygui myview createTreeView
+
+
+    -- add another plugin separator after the existing one
+    -- where we want to place our plugins
+    sep2 <- separatorMenuItemNew
+    widgetShow sep2
+
+    menuShellInsert (rcMenu rcmenu) sep2 insertPos
+
+    plugins <- forM myplugins $ \(ma, mb, mc) -> fmap (, mb, mc) ma
+    -- need to reverse plugins list so the order is right
+    forM_ (reverse plugins) $ \(plugin, filter', cb) -> do
+      showItem <- withItems mygui myview filter'
+
+      menuShellInsert (rcMenu rcmenu) plugin insertPos
+      when showItem $ widgetShow plugin
+      -- init callback
+      plugin `on` menuItemActivated $ withItems mygui myview cb
+
+    menuPopup (rcMenu rcmenu) $ Just (RightButton, t)
+  where
+    doRcMenu = do
+      builder <- builderNew
+      builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
+
+      -- create static right-click menu
+      rcMenu            <- builderGetObject builder castToMenu
+                           (fromString "rcMenu")
+      rcFileOpen        <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileOpen")
+      rcFileExecute     <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileExecute")
+      rcFileNewRegFile  <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileNewRegFile")
+      rcFileNewDir      <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileNewDir")
+      rcFileNewTab      <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileNewTab")
+      rcFileNewTerm     <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileNewTerm")
+      rcFileCut         <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileCut")
+      rcFileCopy        <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileCopy")
+      rcFileRename      <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileRename")
+      rcFilePaste       <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFilePaste")
+      rcFileDelete      <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileDelete")
+      rcFileProperty    <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileProperty")
+      rcFileIconView    <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileIconView")
+      rcFileTreeView    <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileTreeView")
+
+      return $ MkRightClickMenu {..}
 

src/HSFM/GUI/Gtk/Callbacks/Utils.hs

@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
@@ -26,12 +25,16 @@ module HSFM.GUI.Gtk.Callbacks.Utils where
 
 import Control.Monad
   (
-    forM
+    forM_
-  , forM_
+  , when
   )
-import Control.Monad.IO.Class
+import Data.Foldable
   (
-    liftIO
+    for_
+  )
+import Data.Maybe
+  (
+    fromJust
   )
 import GHC.IO.Exception
   (
@@ -42,19 +45,16 @@ import qualified HPath as P
 import HPath.IO
 import HPath.IO.Errors
 import HSFM.FileSystem.FileType
-import HSFM.FileSystem.UtilTypes
+import qualified HSFM.FileSystem.UtilTypes as UT
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Dialogs
 import HSFM.GUI.Gtk.MyView
-import HSFM.GUI.Gtk.Utils
+import HSFM.History
-import HSFM.Utils.IO
-  (
-    modifyTVarIO
-  )
 import Prelude hiding(readFile)
-import Control.Concurrent.STM.TVar
+import Control.Concurrent.MVar
   (
-    readTVarIO
+    putMVar
+  , tryTakeMVar
   )
 
 
@@ -62,49 +62,67 @@ import Control.Concurrent.STM.TVar
 
 -- |Carries out a file operation with the appropriate error handling
 -- allowing the user to react to various exceptions with further input.
-doFileOperation :: FileOperation -> IO ()
+doFileOperation :: UT.FileOperation -> IO ()
-doFileOperation (FCopy (Copy (f':fs') to)) =
+doFileOperation (UT.FCopy (UT.Copy (f':fs') to)) =
-  _doFileOperation (f':fs') to easyCopyOverwrite easyCopy
+  _doFileOperation (f':fs') to (\p1 p2 cm -> easyCopy p1 p2 cm FailEarly)
-    $ doFileOperation (FCopy $ Copy fs' to)
+    $ doFileOperation (UT.FCopy $ UT.Copy fs' to)
-doFileOperation (FMove (Move (f':fs') to)) =
+doFileOperation (UT.FMove (UT.Move (f':fs') to)) =
-  _doFileOperation (f':fs') to moveFileOverwrite moveFile
+  _doFileOperation (f':fs') to moveFile
-    $ doFileOperation (FMove $ Move fs' to)
+    $ doFileOperation (UT.FMove $ UT.Move fs' to)
 doFileOperation _ = return ()
 
 
 _doFileOperation :: [P.Path b1]
                  -> P.Path P.Abs
-                 -> (P.Path b1 -> P.Path P.Abs -> IO b)
+                 -> (P.Path b1 -> P.Path P.Abs -> CopyMode -> IO b)
-                 -> (P.Path b1 -> P.Path P.Abs -> IO a)
                  -> IO ()
                  -> IO ()
-_doFileOperation [] _ _ _ _ = return ()
+_doFileOperation [] _ _ _ = return ()
-_doFileOperation (f:fs) to mcOverwrite mc rest = do
+_doFileOperation (f:fs) to mc rest = do
   toname <- P.basename f
   let topath = to P.</> toname
-  reactOnError (mc f topath >> rest)
+  reactOnError (mc f topath Strict >> rest)
+    -- TODO: how safe is 'AlreadyExists' here?
     [(AlreadyExists  , collisionAction fileCollisionDialog topath)]
-    [(FileDoesExist{}, collisionAction fileCollisionDialog topath)
+    [(SameFile{}     , collisionAction renameDialog topath)]
-    ,(DirDoesExist{} , collisionAction fileCollisionDialog topath)
-    ,(SameFile{}     , collisionAction renameDialog topath)]
   where
     collisionAction diag topath = do
       mcm <- diag . P.fromAbs $ topath
       forM_ mcm $ \cm -> case cm of
-        Overwrite    -> mcOverwrite f topath >> rest
+        UT.Overwrite -> mc f topath Overwrite >> rest
-        OverwriteAll -> forM_ (f:fs) $ \x -> do
+        UT.OverwriteAll -> forM_ (f:fs) $ \x -> do
                           toname' <- P.basename x
-                          mcOverwrite x (to P.</> toname')
+                          mc x (to P.</> toname') Overwrite
-        Skip         -> rest
+        UT.Skip         -> rest
-        Rename newn  -> mc f (to P.</> newn) >> rest
+        UT.Rename newn  -> mc f (to P.</> newn) Strict >> rest
         _            -> return ()
 
 
 -- |Helper that is invoked for any directory change operations.
-goDir :: MyGUI -> MyView -> Item -> IO ()
+goDir :: Bool    -- ^ whether to update the history
-goDir mygui myview item = do
+      -> MyGUI
-  cdir <- getCurrentDir myview
+      -> MyView
-  modifyTVarIO (history myview)
+      -> Item
-    (\(p, _) -> (path cdir `addHistory` p, []))
+      -> IO ()
-  refreshView' mygui myview item
+goDir bhis mygui myview item = do
+  when bhis $ do
+    mhs <- tryTakeMVar (history myview)
+    for_ mhs $ \hs -> do
+      let nhs = historyNewPath (path item) hs
+      putMVar (history myview) nhs
+  refreshView mygui myview item
+
+  -- set notebook tab label
+  page <- notebookGetCurrentPage (notebook myview)
+  child <- fromJust <$> notebookGetNthPage (notebook myview) page
+
+  -- get the label
+  ebox <- (castToEventBox . fromJust)
+    <$> notebookGetTabLabel (notebook myview) child
+  label <- (castToLabel . head) <$> containerGetChildren ebox
+
+  -- set the label
+  labelSetText label
+    (maybe (P.fromAbs $ path item)
+           P.fromRel $ P.basename . path $ item)
 

src/HSFM/GUI/Gtk/Data.hs

@@ -30,13 +30,9 @@ import Control.Concurrent.STM
     TVar
   )
 import Graphics.UI.Gtk hiding (MenuBar)
-import HPath
-  (
-    Abs
-  , Path
-  )
 import HSFM.FileSystem.FileType
 import HSFM.FileSystem.UtilTypes
+import HSFM.History
 import System.INotify
   (
     INotify
@@ -61,7 +57,14 @@ data MyGUI = MkMyGUI {
   , menubar        :: !MenuBar
   , statusBar      :: !Statusbar
   , clearStatusBar :: !Button
-  , notebook       :: !Notebook
+
+  , notebook1      :: !Notebook
+  , leftNbBtn      :: !ToggleButton
+  , leftNbIcon     :: !Image
+
+  , notebook2      :: !Notebook
+  , rightNbBtn     :: !ToggleButton
+  , rightNbIcon    :: !Image
 
   -- other
   , fprop    :: !FilePropertyGrid
@@ -80,16 +83,18 @@ data MyView = MkMyView {
   , sortedModel     :: !(TVar (TypedTreeModelSort Item))
   , filteredModel   :: !(TVar (TypedTreeModelFilter Item))
   , inotify         :: !(MVar INotify)
+  , notebook        :: !Notebook -- current notebook
 
   -- the first part of the tuple represents the "go back"
   -- the second part the "go forth" in the history
-  , history         :: !(TVar ([Path Abs], [Path Abs]))
+  , history         :: !(MVar BrowsingHistory)
 
   -- sub-widgets
   , scroll       :: !ScrolledWindow
   , viewBox      :: !Box
-  , rcmenu       :: !RightClickMenu
+  , backViewB    :: !Button
   , upViewB      :: !Button
+  , forwardViewB :: !Button
   , homeViewB    :: !Button
   , refreshViewB :: !Button
   , urlBar       :: !Entry
@@ -107,6 +112,8 @@ data RightClickMenu = MkRightClickMenu {
   , rcFileExecute    :: !ImageMenuItem
   , rcFileNewRegFile :: !ImageMenuItem
   , rcFileNewDir     :: !ImageMenuItem
+  , rcFileNewTab     :: !ImageMenuItem
+  , rcFileNewTerm    :: !ImageMenuItem
   , rcFileCut        :: !ImageMenuItem
   , rcFileCopy       :: !ImageMenuItem
   , rcFileRename     :: !ImageMenuItem

src/HSFM/GUI/Gtk/Dialogs.hs

@@ -16,17 +16,22 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 module HSFM.GUI.Gtk.Dialogs where
 
 
+import Codec.Binary.UTF8.String
+  (
+    decodeString
+  )
 import Control.Exception
   (
-    displayException
+    catches
+  , displayException
   , throwIO
   , IOException
-  , catches
   , Handler(..)
   )
 import Control.Monad
@@ -44,23 +49,39 @@ import Data.ByteString.UTF8
   (
     fromString
   )
+import Distribution.Package
+  (
+    PackageIdentifier(..)
+  , packageVersion
+  , unPackageName
+  )
+#if MIN_VERSION_Cabal(2,0,0)
+import Distribution.Version
+  (
+    showVersion
+  )
+#else
 import Data.Version
   (
     showVersion
   )
-import Distribution.Package
+#endif
-  (
-    PackageIdentifier(..)
-  , PackageName(..)
-  )
 import Distribution.PackageDescription
   (
     GenericPackageDescription(..)
   , PackageDescription(..)
   )
+#if MIN_VERSION_Cabal(2,2,0)
+import Distribution.PackageDescription.Parsec
+#else
 import Distribution.PackageDescription.Parse
+#endif
   (
-    readPackageDescription
+#if MIN_VERSION_Cabal(2,0,0)
+    readGenericPackageDescription,
+#else
+    readPackageDescription,
+#endif
   )
 import Distribution.Verbosity
   (
@@ -93,7 +114,6 @@ import System.Posix.FilePath
 
 
 
-
     ---------------------
     --[ Dialog popups ]--
     ---------------------
@@ -151,7 +171,7 @@ fileCollisionDialog t = do
     ResponseUser 4 -> do
       mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
       forM mfn $ \fn -> do
-        pfn <- P.parseFn (fromString fn)
+        pfn <- P.parseRel (fromString fn)
         return $ Rename pfn
     _              -> throwIO UnknownDialogButton
 
@@ -176,7 +196,7 @@ renameDialog t = do
     ResponseUser 2 -> do
       mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
       forM mfn $ \fn -> do
-        pfn <- P.parseFn (fromString fn)
+        pfn <- P.parseRel (fromString fn)
         return $ Rename pfn
     _              -> throwIO UnknownDialogButton
 
@@ -188,12 +208,16 @@ showAboutDialog = do
   lstr     <- Prelude.readFile =<< getDataFileName "LICENSE"
   hsfmicon <- pixbufNewFromFile =<< getDataFileName "data/Gtk/icons/hsfm.png"
   pdesc    <- fmap packageDescription
+#if MIN_VERSION_Cabal(2,0,0)
+                   (readGenericPackageDescription silent
+#else
                    (readPackageDescription silent
+#endif
                      =<< getDataFileName "hsfm.cabal")
   set ad
     [ aboutDialogProgramName  := (unPackageName . pkgName . package) pdesc
     , aboutDialogName         := (unPackageName . pkgName . package) pdesc
-    , aboutDialogVersion      := (showVersion . pkgVersion . package) pdesc
+    , aboutDialogVersion      := (showVersion . packageVersion . package) pdesc
     , aboutDialogCopyright    := copyright pdesc
     , aboutDialogComments     := description pdesc
     , aboutDialogLicense      := Just lstr
@@ -220,7 +244,9 @@ withErrorDialog :: IO a -> IO ()
 withErrorDialog io =
   catches (void io)
     [ Handler (\e -> showErrorDialog
-                       $ displayException (e :: IOException))
+                       . decodeString
+                       . displayException
+                       $ (e :: IOException))
     , Handler (\e -> showErrorDialog
                        $ displayException (e :: HPathIOException))
     ]
@@ -228,9 +254,9 @@ withErrorDialog io =
 
 -- |Asks the user which directory copy mode he wants via dialog popup
 -- and returns 'DirCopyMode'.
-textInputDialog :: GlibString string
+textInputDialog :: (GlibString s1, GlibString s2)
-                => string   -- ^ window title
+                => s1   -- ^ window title
-                -> string   -- ^ initial text in input widget
+                -> s2   -- ^ initial text in input widget
                 -> IO (Maybe String)
 textInputDialog title inittext = do
   chooserDialog <- messageDialogNew Nothing
@@ -269,7 +295,7 @@ showFilePropertyDialog [item] mygui _ = do
   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 (fpropTsEntry fprop')  (show . fileSize $ fvar item)
   entrySetText (fpropModEntry fprop') (packModTime item)
   entrySetText (fpropAcEntry fprop')  (packAccessTime item)
   entrySetText (fpropFTEntry fprop')  (packFileType item)

src/HSFM/GUI/Gtk/MyGUI.hs

@@ -45,7 +45,6 @@ import Paths_hsfm
 -- |Set up the GUI. This only creates the permanent widgets.
 createMyGUI :: IO MyGUI
 createMyGUI = do
-
   let settings' = MkFMSettings False True 24
   settings <- newTVarIO settings'
   operationBuffer <- newTVarIO None
@@ -82,8 +81,32 @@ createMyGUI = do
                        "fpropPermEntry"
   fpropLDEntry      <- builderGetObject builder castToEntry
                        "fpropLDEntry"
-  notebook          <- builderGetObject builder castToNotebook
+  notebook1         <- builderGetObject builder castToNotebook
-                       "notebook"
+                       "notebook1"
+  notebook2         <- builderGetObject builder castToNotebook
+                       "notebook2"
+  leftNbIcon        <- builderGetObject builder castToImage
+                       "leftNbIcon"
+  rightNbIcon       <- builderGetObject builder castToImage
+                       "rightNbIcon"
+  leftNbBtn         <- builderGetObject builder castToToggleButton
+                       "leftNbBtn"
+  rightNbBtn        <- builderGetObject builder castToToggleButton
+                       "rightNbBtn"
+
+
+  -- this is required so that hotkeys work as expected, because
+  -- we then can connect to signals from `viewBox` more reliably
+  widgetSetCanFocus notebook1 False
+  widgetSetCanFocus notebook2 False
+
+  -- notebook toggle buttons
+  buttonSetImage leftNbBtn leftNbIcon
+  buttonSetImage rightNbBtn rightNbIcon
+  widgetSetSensitive leftNbIcon False
+  widgetSetSensitive rightNbIcon False
+  toggleButtonSetActive leftNbBtn True
+  toggleButtonSetActive rightNbBtn True
 
   -- construct the gui object
   let menubar = MkMenuBar {..}

src/HSFM/GUI/Gtk/MyView.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 #-}
 
 
 module HSFM.GUI.Gtk.MyView where
@@ -32,16 +33,16 @@ import Control.Concurrent.STM
     newTVarIO
   , readTVarIO
   )
-import Control.Exception
-  (
-    try
-  , SomeException
-  )
 import Control.Monad
   (
-    forM_
+    unless
+  , void
+  , when
+  )
+import Control.Monad.IO.Class
+  (
+    liftIO
   )
-import qualified Data.ByteString as BS
 import Data.Foldable
   (
     for_
@@ -51,23 +52,19 @@ import Data.Maybe
     catMaybes
   , fromJust
   )
-import HPath.IO.Errors
+import Data.String
   (
-    canOpenDirectory
+    fromString
   )
 import Graphics.UI.Gtk
 import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setViewCallbacks)
-import HPath
-  (
-    Path
-  , Abs
-  )
 import qualified HPath as P
 import HSFM.FileSystem.FileType
 import HSFM.GUI.Glib.GlibString()
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Icons
 import HSFM.GUI.Gtk.Utils
+import HSFM.History
 import HSFM.Utils.IO
 import Paths_hsfm
   (
@@ -81,36 +78,72 @@ import System.INotify
   , killINotify
   , EventVariety(..)
   )
+import System.IO.Error
+  (
+    catchIOError
+  , ioError
+  , isUserError
+  )
 import System.Posix.FilePath
   (
-    pathSeparator
+    hiddenFile
-  , hiddenFile
   )
 
 
 
 -- |Creates a new tab with its own view and refreshes the view.
-newTab :: MyGUI -> IO FMView -> Path Abs -> IO MyView
+newTab :: MyGUI -> Notebook -> IO FMView -> Item -> Int -> IO MyView
-newTab mygui iofmv path = do
+newTab mygui nb iofmv item pos = do
-  myview <- createMyView mygui iofmv
+
-  i <- notebookAppendPage (notebook mygui) (viewBox myview)
+
-       (maybe (P.fromAbs path) P.fromRel $ P.basename path)
+  -- create eventbox with label
-  mpage <- notebookGetNthPage (notebook mygui) i
+  label <- labelNewWithMnemonic
-  forM_ mpage $ \page -> notebookSetTabReorderable (notebook mygui)
+    (maybe (P.fromAbs $ path item) P.fromRel $ P.basename $ path item)
-                                                   page
+  ebox <- eventBoxNew
-                                                   True
+  eventBoxSetVisibleWindow ebox False
-  refreshView mygui myview (Just path)
+  containerAdd ebox label
+  widgetShowAll label
+
+  myview <- createMyView mygui nb iofmv
+  _ <- notebookInsertPageMenu (notebook myview) (viewBox myview)
+    ebox ebox pos
+
+  -- set initial history
+  let historySize = 5
+  putMVar (history myview)
+          (BrowsingHistory [] (path item) [] historySize)
+
+  notebookSetTabReorderable (notebook myview) (viewBox myview) True
+
+  catchIOError (refreshView mygui myview item) $ \e -> do
+    file <- pathToFile getFileInfo . fromJust . P.parseAbs . fromString
+      $ "/"
+    refreshView mygui myview file
+    labelSetText label (fromString "/" :: String)
+    unless (isUserError e) (ioError e)
+
+  -- close callback
+  _ <- ebox `on` buttonPressEvent $ do
+    eb <- eventButton
+    case eb of
+      MiddleButton -> liftIO $ do
+        n <- notebookGetNPages (notebook myview)
+        when (n > 1) $ void $ destroyView myview
+        return True
+      _ -> return False
+
   return myview
 
 
 -- |Constructs the initial MyView object with a few dummy models.
 -- It also initializes the callbacks.
 createMyView :: MyGUI
+             -> Notebook
              -> IO FMView
              -> IO MyView
-createMyView mygui iofmv = do
+createMyView mygui nb iofmv = do
   inotify <- newEmptyMVar
-  history <- newTVarIO ([],[])
+  history <- newEmptyMVar
 
   builder <- builderNew
   builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
@@ -127,34 +160,13 @@ createMyView mygui iofmv = do
 
   urlBar            <- builderGetObject builder castToEntry
                        "urlBar"
-  rcMenu            <- builderGetObject builder castToMenu
+
-                       "rcMenu"
+  backViewB         <- builderGetObject builder castToButton
-  rcFileOpen        <- builderGetObject builder castToImageMenuItem
+                       "backViewB"
-                       "rcFileOpen"
-  rcFileExecute     <- builderGetObject builder castToImageMenuItem
-                       "rcFileExecute"
-  rcFileNewRegFile  <- builderGetObject builder castToImageMenuItem
-                       "rcFileNewRegFile"
-  rcFileNewDir      <- builderGetObject builder castToImageMenuItem
-                       "rcFileNewDir"
-  rcFileCut         <- builderGetObject builder castToImageMenuItem
-                       "rcFileCut"
-  rcFileCopy        <- builderGetObject builder castToImageMenuItem
-                       "rcFileCopy"
-  rcFileRename      <- builderGetObject builder castToImageMenuItem
-                       "rcFileRename"
-  rcFilePaste       <- builderGetObject builder castToImageMenuItem
-                       "rcFilePaste"
-  rcFileDelete      <- builderGetObject builder castToImageMenuItem
-                       "rcFileDelete"
-  rcFileProperty    <- builderGetObject builder castToImageMenuItem
-                       "rcFileProperty"
-  rcFileIconView    <- builderGetObject builder castToImageMenuItem
-                       "rcFileIconView"
-  rcFileTreeView    <- builderGetObject builder castToImageMenuItem
-                       "rcFileTreeView"
   upViewB           <- builderGetObject builder castToButton
                        "upViewB"
+  forwardViewB      <- builderGetObject builder castToButton
+                       "forwardViewB"
   homeViewB         <- builderGetObject builder castToButton
                        "homeViewB"
   refreshViewB      <- builderGetObject builder castToButton
@@ -164,7 +176,7 @@ createMyView mygui iofmv = do
   viewBox           <- builderGetObject builder castToBox
                          "viewBox"
 
-  let rcmenu = MkRightClickMenu {..}
+  let notebook = nb
   let myview = MkMyView {..}
 
   -- set the bindings
@@ -185,37 +197,38 @@ switchView :: MyGUI -> MyView -> IO FMView -> IO ()
 switchView mygui myview iofmv = do
   cwd <- getCurrentDir myview
 
-  oldpage <- destroyView mygui myview
+  let nb = notebook myview
+
+  oldpage <- destroyView myview
 
   -- create new view and tab page where the previous one was
-  nview <- createMyView mygui iofmv
+  nview <- newTab mygui nb iofmv cwd oldpage
-  newpage <- notebookInsertPage (notebook mygui) (viewBox nview)
-             (maybe (P.fromAbs $ path cwd) P.fromRel
-                 $ P.basename . path $ cwd) oldpage
-  notebookSetCurrentPage (notebook mygui) newpage
 
-  refreshView' mygui nview cwd
+  page <- fromJust <$> notebookPageNum nb (viewBox nview)
+  notebookSetCurrentPage nb page
+
+  refreshView mygui nview cwd
 
 
--- |Destroys the current view by disconnecting the watcher
+-- |Destroys the given view by disconnecting the watcher
 -- and destroying the active FMView container.
 --
 -- Everything that needs to be done in order to forget about a
 -- view needs to be done here.
 --
 -- Returns the page in the tab list this view corresponds to.
-destroyView :: MyGUI -> MyView -> IO Int
+destroyView :: MyView -> IO Int
-destroyView mygui myview = do
+destroyView myview = do
   -- disconnect watcher
   mi <- tryTakeMVar (inotify myview)
   for_ mi $ \i -> killINotify i
 
-  page <- notebookGetCurrentPage (notebook mygui)
+  page <- fromJust <$> notebookPageNum (notebook myview) (viewBox myview)
 
   -- destroy old view and tab page
   view' <- readTVarIO $ view myview
   widgetDestroy (fmViewToContainer view')
-  notebookRemovePage (notebook mygui) page
+  notebookRemovePage (notebook myview) page
 
   return page
 
@@ -291,46 +304,18 @@ createTreeView = do
   return $ FMTreeView treeView
 
 
--- |Re-reads the current directory or the given one and updates the View.
--- This is more or less a wrapper around `refreshView'`
---
--- If the third argument is Nothing, it tries to re-read the current directory.
--- If that fails, it reads "/" instead.
---
--- If the third argument is (Just path) it tries to read "path". If that
--- fails, it reads "/" instead.
-refreshView :: MyGUI
-            -> MyView
-            -> Maybe (Path Abs)
-            -> IO ()
-refreshView mygui myview mfp =
-  case mfp of
-    Just fp  -> do
-      canopen <- canOpenDirectory fp
-      if canopen
-         then refreshView' mygui myview =<< readFile getFileInfo fp
-         else refreshView mygui myview =<< getAlternativeDir
-    Nothing  -> refreshView mygui myview =<< getAlternativeDir
-    where
-      getAlternativeDir = do
-        ecd <- try (getCurrentDir myview) :: IO (Either SomeException
-                                                     Item)
-        case ecd of
-          Right dir -> return (Just $ path dir)
-          Left _    -> return (P.parseAbs $ BS.singleton pathSeparator)
-
-
 -- |Refreshes the View based on the given directory.
 --
--- If the directory is not a Dir or a Symlink pointing to a Dir, then
+-- Throws:
--- calls `refreshView` with the 3rd argument being Nothing.
+--
-refreshView' :: MyGUI
+--   - `userError` on inappropriate type
+refreshView :: MyGUI
              -> MyView
              -> Item
              -> IO ()
-refreshView' mygui myview SymLink { sdest = d@Dir{} } =
+refreshView mygui myview SymLink { sdest = Just d@Dir{} } =
-  refreshView' mygui myview d
+  refreshView mygui myview d
-refreshView' mygui myview item@Dir{} = do
+refreshView mygui myview item@Dir{} = do
   newRawModel  <- fileListStore item myview
   writeTVarIO (rawModel myview) newRawModel
 
@@ -345,12 +330,6 @@ refreshView' mygui myview item@Dir{} = do
 
   constructView mygui myview
 
-  -- set notebook tab label
-  page <- notebookGetCurrentPage (notebook mygui)
-  child <- fromJust <$> notebookGetNthPage (notebook mygui) page
-  notebookSetTabLabelText (notebook mygui) child
-       (maybe (P.fromAbs $ path item) P.fromRel $ P.basename . path $ item)
-
   -- reselect selected items
   -- TODO: not implemented for icon view yet
   case view' of
@@ -359,8 +338,7 @@ refreshView' mygui myview item@Dir{} = do
       ntps <- mapM treeRowReferenceGetPath trs
       mapM_ (treeSelectionSelectPath tvs) ntps
     _ -> return ()
-refreshView' mygui myview Failed{} = refreshView mygui myview Nothing
+refreshView _ _ _ = ioError $ userError "Inappropriate type!"
-refreshView' _ _ _ = return ()
 
 
 -- |Constructs the visible View with the current underlying mutable models,
@@ -385,14 +363,14 @@ constructView mygui myview = do
       dirtreePix FileLike{}      = filePix
       dirtreePix DirSym{}        = folderSymPix
       dirtreePix FileLikeSym{}   = fileSymPix
-      dirtreePix Failed{}        = errorPix
       dirtreePix BrokenSymlink{} = errorPix
       dirtreePix _               = errorPix
 
 
   view' <- readTVarIO $ view myview
 
-  cdirp <- path <$> getCurrentDir myview
+  cdir <- getCurrentDir myview
+  let cdirp = path cdir
 
   -- update urlBar
   entrySetText (urlBar myview) (P.fromAbs cdirp)
@@ -433,7 +411,7 @@ constructView mygui myview = do
   -- update model of view
   case view' of
     FMTreeView treeView -> do
-      treeViewSetModel treeView sortedModel'
+      treeViewSetModel treeView (Just sortedModel')
       treeViewSetRubberBanding treeView True
     FMIconView iconView -> do
       iconViewSetModel iconView (Just sortedModel')
@@ -450,7 +428,7 @@ constructView mygui myview = do
          newi
          [Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
          (P.fromAbs cdirp)
-         (\_ -> postGUIAsync $ refreshView mygui myview (Just $ cdirp))
+         (\_ -> postGUIAsync $ refreshView mygui myview cdir)
   putMVar (inotify myview) newi
 
   return ()

src/HSFM/GUI/Gtk/Plugins.hs

@@ -0,0 +1,112 @@
+{--
+HSFM, a filemanager written in Haskell.
+Copyright (C) 2016 Julian Ospald
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+version 2 as published by the Free Software Foundation.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+--}
+
+
+{-# OPTIONS_HADDOCK ignore-exports #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+
+
+module HSFM.GUI.Gtk.Plugins where
+
+
+import Graphics.UI.Gtk
+import HPath
+import HSFM.FileSystem.FileType
+import HSFM.GUI.Gtk.Data
+import HSFM.GUI.Gtk.Settings
+import HSFM.GUI.Gtk.Utils
+import HSFM.Settings
+import Control.Monad
+  (
+    forM
+  , forM_
+  , void
+  )
+import System.Posix.Process.ByteString
+  (
+    executeFile
+  , forkProcess
+  )
+import Data.ByteString.UTF8
+  (
+    fromString
+  )
+import qualified Data.ByteString as BS
+
+
+
+
+
+    ---------------
+    --[ Plugins ]--
+    ---------------
+
+
+
+
+---- Global settings ----
+
+
+
+-- |Where to start inserting plugins.
+insertPos :: Int
+insertPos = 4
+
+
+-- |A list of plugins to add to the right-click menu at position
+-- `insertPos`.
+--
+-- The left part of the triple is a function that returns the menuitem.
+-- The middle part of the triple is a filter function that
+-- decides whether the item is shown.
+-- The right part of the triple is the callback, which is invoked
+-- when the menu item is clicked.
+--
+-- Plugins are added in order of this list.
+myplugins :: [(IO MenuItem
+              ,[Item] -> MyGUI -> MyView -> IO Bool
+              ,[Item] -> MyGUI -> MyView -> IO ())
+             ]
+myplugins = [(diffItem, diffFilter, diffCallback)
+            ]
+
+
+
+
+
+---- The plugins ----
+
+
+
+diffItem :: IO MenuItem
+diffItem = menuItemNewWithLabel "diff"
+
+diffFilter :: [Item] -> MyGUI -> MyView -> IO Bool
+diffFilter items _ _
+  | length items > 1 = return $ and $ fmap isFileC items
+  | otherwise        = return False
+
+diffCallback :: [Item] -> MyGUI -> MyView -> IO ()
+diffCallback items _ _ = void $
+  forkProcess $
+    executeFile
+      (fromString "meld")
+      True
+      ([fromString "--diff"] ++ fmap (fromAbs . path) items)
+      Nothing
+

src/HSFM/GUI/Gtk/Settings.hs

@@ -0,0 +1,128 @@
+{--
+HSFM, a filemanager written in Haskell.
+Copyright (C) 2016 Julian Ospald
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+version 2 as published by the Free Software Foundation.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+--}
+
+{-# LANGUAGE PatternSynonyms #-}
+
+
+module HSFM.GUI.Gtk.Settings where
+
+
+import Graphics.UI.Gtk
+
+
+
+
+    --------------------
+    --[ GUI Settings ]--
+    --------------------
+
+
+
+---- Hotkey settings ----
+
+
+pattern QuitModifier :: [Modifier]
+pattern QuitModifier <- [Control]
+
+pattern QuitKey :: String
+pattern QuitKey <- "q"
+
+
+pattern ShowHiddenModifier :: [Modifier]
+pattern ShowHiddenModifier <- [Control]
+
+pattern ShowHiddenKey :: String
+pattern ShowHiddenKey <- "h"
+
+
+pattern UpDirModifier :: [Modifier]
+pattern UpDirModifier <- [Alt]
+
+pattern UpDirKey :: String
+pattern UpDirKey <- "Up"
+
+
+pattern HistoryBackModifier :: [Modifier]
+pattern HistoryBackModifier <- [Alt]
+
+pattern HistoryBackKey :: String
+pattern HistoryBackKey <- "Left"
+
+
+pattern HistoryForwardModifier :: [Modifier]
+pattern HistoryForwardModifier <- [Alt]
+
+pattern HistoryForwardKey :: String
+pattern HistoryForwardKey <- "Right"
+
+
+pattern DeleteModifier :: [Modifier]
+pattern DeleteModifier <- []
+
+pattern DeleteKey :: String
+pattern DeleteKey <- "Delete"
+
+
+pattern OpenModifier :: [Modifier]
+pattern OpenModifier <- []
+
+pattern OpenKey :: String
+pattern OpenKey <- "Return"
+
+
+pattern CopyModifier :: [Modifier]
+pattern CopyModifier <- [Control]
+
+pattern CopyKey :: String
+pattern CopyKey <- "c"
+
+
+pattern MoveModifier :: [Modifier]
+pattern MoveModifier <- [Control]
+
+pattern MoveKey :: String
+pattern MoveKey <- "x"
+
+
+pattern PasteModifier :: [Modifier]
+pattern PasteModifier <- [Control]
+
+pattern PasteKey :: String
+pattern PasteKey <- "v"
+
+
+pattern NewTabModifier :: [Modifier]
+pattern NewTabModifier <- [Control]
+
+pattern NewTabKey :: String
+pattern NewTabKey <- "t"
+
+
+pattern CloseTabModifier :: [Modifier]
+pattern CloseTabModifier <- [Control]
+
+pattern CloseTabKey :: String
+pattern CloseTabKey <- "w"
+
+
+pattern OpenTerminalModifier :: [Modifier]
+pattern OpenTerminalModifier <- []
+
+pattern OpenTerminalKey :: String
+pattern OpenTerminalKey <- "F4"
+

src/HSFM/GUI/Gtk/Utils.hs

@@ -78,8 +78,8 @@ withItems :: MyGUI
           -> (   [Item]
               -> MyGUI
               -> MyView
-              -> IO ()) -- ^ action to carry out
+              -> IO a) -- ^ action to carry out
-          -> IO ()
+          -> IO a
 withItems mygui myview io = do
   items <- getSelectedItems mygui myview
   io items mygui myview
@@ -152,15 +152,3 @@ rawPathToItem myview tp = do
   miter     <- rawPathToIter myview tp
   forM miter $ \iter -> treeModelGetRow rawModel' iter
 
-
--- |Makes sure the list is max 5. This is probably not very efficient
--- but we don't care, since it's a small list anyway.
-addHistory :: Eq a => a -> [a] -> [a]
-addHistory i [] = [i]
-addHistory i xs@(x:_)
-  | i == x                 = xs
-  | length xs == maxLength = i : take (maxLength - 1) xs
-  | otherwise              = i : xs
-  where
-    maxLength = 10
-

src/HSFM/History.hs

@@ -0,0 +1,61 @@
+{--
+HSFM, a filemanager written in Haskell.
+Copyright (C) 2016 Julian Ospald
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+version 2 as published by the Free Software Foundation.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+--}
+
+{-# OPTIONS_HADDOCK ignore-exports #-}
+
+module HSFM.History where
+
+
+import HPath
+  (
+    Abs
+  , Path
+  )
+
+
+
+-- |Browsing history. For `forwardHistory` and `backwardsHistory`
+-- the first item is the most recent one.
+data BrowsingHistory = BrowsingHistory {
+    backwardsHistory :: [Path Abs]
+  , currentDir       :: Path Abs
+  , forwardHistory   :: [Path Abs]
+  , maxSize          :: Int
+}
+
+
+-- |This is meant to be called after e.g. a new path is entered
+-- (not navigated to via the history) and the history needs updating.
+historyNewPath :: Path Abs -> BrowsingHistory -> BrowsingHistory
+historyNewPath p (BrowsingHistory b cd _ s) =
+  BrowsingHistory (take s $ cd:b) p [] s
+
+
+-- |Go back one step in the history.
+historyBack :: BrowsingHistory -> BrowsingHistory
+historyBack bh@(BrowsingHistory [] _ _ _)   = bh
+historyBack (BrowsingHistory (b:bs) cd fs s) =
+  BrowsingHistory bs b (take s $ cd:fs) s
+
+
+-- |Go forward one step in the history.
+historyForward :: BrowsingHistory -> BrowsingHistory
+historyForward bh@(BrowsingHistory _ _ [] _) = bh
+historyForward (BrowsingHistory bs cd (f:fs) s) =
+  BrowsingHistory (take s $ cd:bs) f fs s
+

src/HSFM/Settings.hs

@@ -0,0 +1,67 @@
+{--
+HSFM, a filemanager written in Haskell.
+Copyright (C) 2016 Julian Ospald
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+version 2 as published by the Free Software Foundation.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+--}
+
+{-# OPTIONS_HADDOCK ignore-exports #-}
+
+
+module HSFM.Settings where
+
+
+import Data.ByteString
+  (
+    ByteString
+  )
+import qualified Data.ByteString.UTF8 as BU
+import Data.Maybe
+import System.Posix.Env.ByteString
+import System.Posix.Process.ByteString
+
+
+
+    -----------------------
+    --[ Common Settings ]--
+    -----------------------
+
+
+
+
+---- Command settings ----
+
+
+
+-- |The terminal command. This should call `executeFile` in the end
+-- with the appropriate arguments.
+terminalCommand :: ByteString  -- ^ current directory of the FM
+                -> IO a
+terminalCommand cwd =
+  executeFile                   -- executes the given command
+    (BU.fromString "sakura")    -- the terminal command
+    True                        -- whether to search PATH
+    [BU.fromString "-d", cwd]   -- arguments for the command
+    Nothing                     -- optional custom environment: `Just [(String, String)]`
+
+
+-- |The home directory. If you want to set it explicitly, you might
+-- want to do:
+--
+-- @
+-- home = return "\/home\/wurst"
+-- @
+home :: IO ByteString
+home = fromMaybe <$> return (BU.fromString "/") <*> getEnv (BU.fromString "HOME")
+

src/HSFM/Utils/MyPrelude.hs

@@ -19,7 +19,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 module HSFM.Utils.MyPrelude where
 
 
-import Data.Default
 import Data.List
 
 
@@ -31,6 +30,3 @@ listIndices :: [a] -> [Int]
 listIndices = findIndices (const True)
 
 
--- |A `maybe` flavor using the `Default` class.
-maybeD :: (Default b) => (a -> b) -> Maybe a -> b
-maybeD = maybe def

update-gh-pages.sh

@@ -0,0 +1,52 @@
+#!/bin/bash
+
+SOURCE_BRANCH="master"
+TARGET_BRANCH="gh-pages"
+REPO="https://${GH_TOKEN}@github.com/hasufell/hsfm"
+DOC_LOCATION="/dist/doc/html/hsfm/hsfm-gtk"
+
+
+# Pull requests and commits to other branches shouldn't try to deploy,
+# just build to verify
+if [ "$TRAVIS_PULL_REQUEST" != "false" -o "$TRAVIS_BRANCH" != "$SOURCE_BRANCH" ]; then
+    echo "Skipping docs deploy."
+    exit 0
+fi
+
+
+cd "$HOME"
+git config --global user.email "travis@travis-ci.org"
+git config --global user.name "travis-ci"
+git clone --branch=${TARGET_BRANCH} ${REPO} ${TARGET_BRANCH} || exit 1
+
+# docs
+cd ${TARGET_BRANCH} || exit 1
+echo "Removing old docs."
+rm -rf *
+echo "Adding new docs."
+cp -rf "${TRAVIS_BUILD_DIR}${DOC_LOCATION}"/* . || exit 1
+
+# If there are no changes to the compiled out (e.g. this is a README update)
+# then just bail.
+if [ -z "`git diff --exit-code`" ]; then
+    echo "No changes to the output on this push; exiting."
+    exit 0
+fi
+
+git add -- .
+
+if [[ -e ./index.html ]] ; then
+	echo "Commiting docs."
+	git commit -m "Lastest docs updated
+
+travis build: $TRAVIS_BUILD_NUMBER
+commit: $TRAVIS_COMMIT
+auto-pushed to gh-pages"
+
+	git push origin $TARGET_BRANCH
+	echo "Published docs to gh-pages."
+else
+	echo "Error: docs are empty."
+	exit 1
+fi
+

update-index-state.sh

@@ -0,0 +1,66 @@
+#!/usr/bin/env bash
+
+set -eu
+
+status_message() {
+    printf "\\033[0;32m%s\\033[0m\\n" "$1"
+}
+
+error_message() {
+    printf "\\033[0;31m%s\\033[0m\\n" "$1"
+}
+
+SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )"
+CACHE_LOCATION="${HOME}/.cabal/packages/hackage.haskell.org/01-index.cache"
+
+if [ ! -f "${CACHE_LOCATION}" ] ; then
+	error_message "${CACHE_LOCATION} does not exist, did you run 'cabal update'?"
+	exit 1
+fi
+
+if [ ! -f "${SCRIPTPATH}/cabal.project" ] ; then
+	error_message "Could not find ${SCRIPTPATH}/cabal.project, skipping index state update."
+	exit 3
+fi
+
+cabal v2-update
+
+arch=$(getconf LONG_BIT)
+
+case "${arch}" in
+32)
+	byte_size=4
+	magic_word="CABA1002"
+    ;;
+64)
+	byte_size=8
+	magic_word="00000000CABA1002"
+    ;;
+*)
+	error_message "Unknown architecture (long bit): ${arch}"
+	exit 2
+    ;;
+esac
+
+# This is the logic to parse the binary format of 01-index.cache.
+# The first word is a magic 'caba1002', the second one is the timestamp in unix epoch.
+# Better than copying the cabal-install source code.
+if [ "$(xxd -u -p -l${byte_size} -s 0 "${CACHE_LOCATION}")" != "${magic_word}" ] ; then
+	error_message "Magic word does not match!"
+	exit 4
+fi
+cache_timestamp=$(echo "ibase=16;obase=A;$(xxd -u -p -l${byte_size} -s ${byte_size} "${CACHE_LOCATION}")" | bc)
+
+# If we got junk from the binary file, this should fail.
+cache_date=$(date --utc --date "@${cache_timestamp}" "+%FT%TZ")
+
+
+status_message "Updating index state in ${SCRIPTPATH}/cabal.project"
+
+if grep -q "^index-state: .*" "${SCRIPTPATH}/cabal.project" ; then
+	awk '/index-state:/ {gsub(/.*/, "index-state: '${cache_date}'")}; { print }' "${SCRIPTPATH}/cabal.project" > "${SCRIPTPATH}/cabal.project.tmp"
+	mv "${SCRIPTPATH}/cabal.project.tmp" "${SCRIPTPATH}/cabal.project"
+else
+	printf "index-state: %s\n" "${cache_date}" >> "${SCRIPTPATH}/cabal.project"
+fi
+