Skip build with 7.8.4, which has annoying failures

Fix base and cabal version constraints
Update HACKING.md
2016-05-30 14:40:23 +02:00 · 2016-05-30 14:40:03 +02:00 · 2016-05-30 14:37:15 +02:00 · 2016-05-30 14:20:00 +02:00 · 2016-05-30 13:56:02 +02:00 · 2016-05-30 13:52:37 +02:00
28 changed files with 515 additions and 1541 deletions
--- a/.gitignore
+++ b/.gitignore
@ -1,15 +1,9 @@
-*.hp
-*.old
-*.prof
-*~
-.cabal-sandbox/
-.ghc.environment.*
-.liquid/
-.stack-work/
-3rdparty/hpath
-cabal.sandbox.config
-dist-newstyle/
 dist/
-hscope.out
-.ghcup
-/bin/
+.cabal-sandbox/
+cabal.sandbox.config
+*~
+*.hp
+*.prof
+*.old
+.liquid/
+3rdparty/hpath
--- a/.travis.yml
+++ b/.travis.yml
@ -7,24 +7,17 @@ dist: trusty

 matrix:
  include:
+    - env: CABALVER=1.24 GHCVER=7.10.2
+      addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.2,libgtk2.0-dev,libgtk-3-dev], sources: [hvr-ghc]}}
    - 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]}}
+      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1,libgtk2.0-dev,libgtk-3-dev], 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:
@ -54,13 +47,7 @@ script:
   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
+   fi

 notifications:
  email:
--- a/README.md
+++ b/README.md
@ -1,8 +1,7 @@
 HSFM
 ====

-[![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)
+[![Build Status](https://api.travis-ci.org/hasufell/hsfm.png?branch=master)](http://travis-ci.org/hasufell/hsfm)

 A Gtk+:3 filemanager written in Haskell.

@ -16,13 +15,17 @@ Design goals:
 Screenshots
 -----------

-![hsfm](https://cloud.githubusercontent.com/assets/1241845/20034565/6c3ae80e-a3c2-11e6-882c-9fe0ff202045.png "hsfm-gtk")
+![hsfm](https://cloud.githubusercontent.com/assets/1241845/14768900/06efd43c-0a4d-11e6-939e-6b067bdb47ce.png "hsfm-gtk")

 Installation
 ------------

 ```
-./install.sh
+cabal sandbox init
+cabal install alex happy
+export PATH="$(pwd)/.cabal-sandbox/bin:$PATH"
+cabal install gtk2hs-buildtools
+cabal install
 ```


--- a/cabal.project
+++ b/cabal.project
@ -1,10 +0,0 @@
-with-compiler: ghc-8.6.5
-
-packages: .
-
-optimization: 2
-
-package *
-    optimization: 2
-
-index-state: 2020-01-24T20:23:40Z
--- a/cabal.project.freeze
+++ b/cabal.project.freeze
@ -1,80 +0,0 @@
-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
--- a/data/Gtk/builder.xml
+++ b/data/Gtk/builder.xml
@ -1,5 +1,5 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<!-- Generated with glade 3.20.0 -->
+<!-- Generated with glade 3.18.3 -->
 <interface>
  <requires lib="gtk+" version="3.16"/>
  <object class="GtkGrid" id="fpropGrid">
@ -361,123 +361,39 @@
          </packing>
        </child>
        <child>
-          <object class="GtkBox">
+          <object class="GtkNotebook" id="notebook">
            <property name="visible">True</property>
-            <property name="can_focus">False</property>
+            <property name="can_focus">True</property>
+            <property name="scrollable">True</property>
            <child>
-              <object class="GtkPaned">
-                <property name="visible">True</property>
-                <property name="can_focus">True</property>
-                <child>
-                  <object class="GtkNotebook" id="notebook1">
-                    <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>
-                <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>
+              <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="expand">True</property>
            <property name="fill">True</property>
-            <property name="position">1</property>
+            <property name="position">2</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>
@ -494,7 +410,7 @@
              <packing>
                <property name="expand">True</property>
                <property name="fill">True</property>
-                <property name="position">2</property>
+                <property name="position">0</property>
              </packing>
            </child>
            <child>
@ -511,48 +427,14 @@
              <packing>
                <property name="expand">False</property>
                <property name="fill">True</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>
+                <property name="position">1</property>
              </packing>
            </child>
          </object>
          <packing>
            <property name="expand">False</property>
            <property name="fill">True</property>
-            <property name="position">2</property>
+            <property name="position">3</property>
          </packing>
        </child>
      </object>
@ -578,16 +460,6 @@
    <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>
@ -638,30 +510,6 @@
                <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>
@ -695,6 +543,7 @@
        <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>
@ -765,16 +614,6 @@
      </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>
@ -784,37 +623,24 @@
        <property name="visible">True</property>
        <property name="can_focus">False</property>
        <child>
-          <object class="GtkButton" id="backViewB">
+          <object class="GtkEntry" id="urlBar">
            <property name="visible">True</property>
            <property name="can_focus">True</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>
+            <property name="input_purpose">url</property>
          </object>
          <packing>
-            <property name="expand">False</property>
+            <property name="expand">True</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>
-            <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>
+            <property name="use_stock">True</property>
          </object>
          <packing>
            <property name="expand">False</property>
@ -824,37 +650,26 @@
          </packing>
        </child>
        <child>
-          <object class="GtkButton" id="forwardViewB">
+          <object class="GtkButton" id="homeViewB">
+            <property name="label">gtk-home</property>
            <property name="visible">True</property>
            <property name="can_focus">True</property>
            <property name="receives_default">True</property>
-            <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>
+            <property name="use_stock">True</property>
          </object>
          <packing>
            <property name="expand">False</property>
            <property name="fill">True</property>
-            <property name="padding">2</property>
            <property name="position">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>
-            <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>
+            <property name="use_stock">True</property>
          </object>
          <packing>
            <property name="expand">False</property>
@ -863,37 +678,6 @@
            <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>
@ -915,7 +699,7 @@
      <packing>
        <property name="expand">True</property>
        <property name="fill">True</property>
-        <property name="position">2</property>
+        <property name="position">1</property>
      </packing>
    </child>
  </object>
--- a/hsfm.cabal
+++ b/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.22
+cabal-version:       >=1.24

 data-files:
                     LICENSE
@ -26,20 +26,16 @@ library
  exposed-modules:
                       HSFM.FileSystem.FileType
                       HSFM.FileSystem.UtilTypes
-                       HSFM.History
-                       HSFM.Settings
                       HSFM.Utils.IO
                       HSFM.Utils.MyPrelude

  build-depends:
-                       IfElse,
                       base >= 4.8 && < 5,
                       bytestring,
+                       data-default,
                       filepath >= 1.3.0.0,
                       hinotify-bytestring,
-                       hpath >= 0.11.0 ,
-                       hpath-filepath >= 0.10.3,
-                       hpath-io >= 0.12.0,
+                       hpath >= 0.7.1,
                       safe,
                       stm,
                       time >= 1.4.2,
@ -57,9 +53,6 @@ library
 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
@ -69,28 +62,20 @@ 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,
-                       IfElse,
+                       Cabal >= 1.24.0.0,
                       base >= 4.8 && < 5,
                       bytestring,
+                       data-default,
                       filepath >= 1.3.0.0,
                       glib >= 0.13,
                       gtk3 >= 0.14.1,
                       hinotify-bytestring,
-                       hpath >= 0.11.0 ,
-                       hpath-filepath >= 0.10.3,
-                       hpath-io >= 0.12.0,
+                       hpath >= 0.7.1,
                       hsfm,
-                       monad-loops,
                       old-locale >= 1,
                       process,
                       safe,
--- a/install.sh
+++ b/install.sh
@ -1,42 +0,0 @@
-#!/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"
-
--- a/src/HSFM/FileSystem/FileType.hs
+++ b/src/HSFM/FileSystem/FileType.hs
@ -42,6 +42,7 @@ import Data.ByteString.UTF8
  (
    toString
  )
+import Data.Default
 import Data.Time.Clock.POSIX
  (
    POSIXTime
@ -56,7 +57,13 @@ 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
  (
    (</>)
@ -91,9 +98,13 @@ 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.
+-- think of. We catch any IO errors in the Failed constructor.
 data File a =
-  Dir {
+    Failed {
+    path :: !(Path Abs)
+  , err  :: IOError
+  }
+  | Dir {
    path :: !(Path Abs)
  , fvar :: a
  }
@ -104,8 +115,8 @@ data File a =
  | SymLink {
    path    :: !(Path Abs)
  , fvar    :: a
-  , sdest   :: Maybe (File a)  -- ^ symlink madness,
-                               --   we need to know where it points to
+  , sdest   :: File a  -- ^ symlink madness,
+                       --   we need to know where it points to
  , rawdest :: !ByteString
  }
  | BlockDev {
@ -176,31 +187,28 @@ fileLike f             = (False, f)


 sdir :: File FileInfo -> (Bool, File FileInfo)
-sdir f@SymLink{ sdest = (Just s@SymLink{} )}
+sdir f@SymLink{ sdest = (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 = Just Dir{} }
+sdir f@SymLink{ sdest = 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))
@ -215,33 +223,31 @@ brokenSymlink f = (isBrokenSymlink f, f)


 fileLikeSym :: File FileInfo -> (Bool, File FileInfo)
-fileLikeSym f@SymLink{ sdest = Just s@SymLink{} }
+fileLikeSym f@SymLink{ sdest = s@SymLink{} }
  = case fileLikeSym s of
      (True, _) -> (True, f)
      _         -> (False, f)
-fileLikeSym f@SymLink{ sdest = Just RegFile{} }   = (True, f)
-fileLikeSym f@SymLink{ sdest = Just BlockDev{} }  = (True, f)
-fileLikeSym f@SymLink{ sdest = Just CharDev{} }   = (True, f)
-fileLikeSym f@SymLink{ sdest = Just NamedPipe{} } = (True, f)
-fileLikeSym f@SymLink{ sdest = Just Socket{} }    = (True, f)
+fileLikeSym f@SymLink{ sdest = RegFile{} }   = (True, f)
+fileLikeSym f@SymLink{ sdest = BlockDev{} }  = (True, f)
+fileLikeSym f@SymLink{ sdest = CharDev{} }   = (True, f)
+fileLikeSym f@SymLink{ sdest = NamedPipe{} } = (True, f)
+fileLikeSym f@SymLink{ sdest = Socket{} }    = (True, f)
 fileLikeSym f                                = (False, f)


 dirSym :: File FileInfo -> (Bool, File FileInfo)
-dirSym f@SymLink{ sdest = Just s@SymLink{} }
+dirSym f@SymLink{ sdest = s@SymLink{} }
  = case dirSym s of
      (True, _) -> (True, f)
      _         -> (False, f)
-dirSym f@SymLink{ sdest = Just Dir{} } = (True, f)
+dirSym f@SymLink{ sdest = 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))


@ -249,11 +255,9 @@ 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
@ -261,7 +265,6 @@ 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))


@ -300,10 +303,11 @@ instance Ord (File FileInfo) where

 -- |Reads a file or directory Path into an `AnchoredFile`, filling the free
 -- variables via the given function.
-pathToFile :: (Path Abs -> IO a)
-           -> Path Abs
-           -> IO (File a)
-pathToFile ff p = do
+readFile :: (Path Abs -> IO a)
+         -> Path Abs
+         -> IO (File a)
+readFile ff p =
+  handleDT p $ do
    fs   <- PF.getSymbolicLinkStatus (P.toFilePath p)
    fv   <- ff p
    constructFile fs fv p
@ -313,12 +317,11 @@ pathToFile ff p = do
          -- symlink madness, we need to make sure we save the correct
          -- File
          x <- PF.readSymbolicLink (P.fromAbs p')
-          resolvedSyml <- handleIOError (\_ -> return Nothing) $ do
+          resolvedSyml <- handleDT p' $ do
            -- watch out, we call </> from 'filepath' here, but it is safe
            let sfp = (P.fromAbs . P.dirname $ p') </> x
            rsfp <- realpath sfp
-            f <- pathToFile ff =<< P.parseAbs rsfp
-            return $ Just f
+            readFile ff =<< P.parseAbs rsfp
          return $ SymLink p' fv resolvedSyml x
      | PF.isDirectory       fs = return $ Dir       p' fv
      | PF.isRegularFile     fs = return $ RegFile   p' fv
@ -326,7 +329,8 @@ pathToFile ff p = do
      | PF.isCharacterDevice fs = return $ CharDev   p' fv
      | PF.isNamedPipe       fs = return $ NamedPipe p' fv
      | PF.isSocket          fs = return $ Socket    p' fv
-      | otherwise               = ioError $ userError "Unknown filetype!"
+      | otherwise               = return $ Failed    p' (userError
+                                                         "Unknown filetype!")


 -- |Get the contents of a given directory and return them as a list
@ -336,7 +340,8 @@ readDirectoryContents :: (Path Abs -> IO a)  -- ^ fills free a variable
                      -> IO [File a]
 readDirectoryContents ff p = do
  files <- getDirsFiles p
-  mapM (pathToFile ff) files
+  fcs   <- mapM (readFile ff) files
+  return fcs


 -- |A variant of `readDirectoryContents` where the second argument
@ -352,12 +357,12 @@ getContents _ _ = return []

 -- |Go up one directory in the filesystem hierarchy.
 goUp :: File FileInfo -> IO (File FileInfo)
-goUp file = pathToFile getFileInfo (P.dirname . path $ file)
+goUp file = readFile getFileInfo (P.dirname . path $ file)


 -- |Go up one directory in the filesystem hierarchy.
 goUp' :: Path Abs -> IO (File FileInfo)
-goUp' fp = pathToFile getFileInfo $ P.dirname fp
+goUp' fp = readFile getFileInfo $ P.dirname fp



@ -368,6 +373,28 @@ goUp' fp = pathToFile 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 ----
@ -375,7 +402,11 @@ goUp' fp = pathToFile getFileInfo $ P.dirname fp

 -- 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:
@ -435,6 +466,8 @@ isSocketC _        = False



+
+
 -- |Gets all file information.
 getFileInfo :: Path Abs -> IO FileInfo
 getFileInfo fp = do
@ -457,6 +490,17 @@ 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: ----
@ -467,7 +511,7 @@ getFileInfo fp = do
 --
 -- When called on a non-symlink, returns False.
 isBrokenSymlink :: File FileInfo -> Bool
-isBrokenSymlink (SymLink _ _ Nothing _) = True
+isBrokenSymlink (SymLink _ _ Failed{} _) = True
 isBrokenSymlink _ = False


@ -479,13 +523,13 @@ isBrokenSymlink _ = False
 -- |Pack the modification time into a string.
 packModTime :: File FileInfo
            -> String
-packModTime = epochToString . modificationTime . fvar
+packModTime = fromFreeVar $ epochToString . modificationTime


 -- |Pack the modification time into a string.
 packAccessTime :: File FileInfo
               -> String
-packAccessTime = epochToString . accessTime . fvar
+packAccessTime = fromFreeVar $ epochToString . accessTime


 epochToString :: EpochTime -> String
@ -495,12 +539,12 @@ epochToString =  show . posixSecondsToUTCTime . realToFrac
 -- |Pack the permissions into a string, similar to what "ls -l" does.
 packPermissions :: File FileInfo
                -> String
-packPermissions file = (pStr . fileMode) . fvar $ file
+packPermissions dt = fromFreeVar (pStr . fileMode) dt
  where
    pStr :: FileMode -> String
    pStr ffm = typeModeStr ++ ownerModeStr ++ groupModeStr ++ otherModeStr
      where
-        typeModeStr = case file of
+        typeModeStr = case dt of
          Dir {}       -> "d"
          RegFile {}   -> "-"
          SymLink {}   -> "l"
@ -508,6 +552,7 @@ packPermissions file = (pStr . fileMode) . fvar $ file
          CharDev {}   -> "c"
          NamedPipe {} -> "p"
          Socket {}    -> "s"
+          _            -> "?"
        ownerModeStr =    hasFmStr PF.ownerReadMode    "r"
                       ++ hasFmStr PF.ownerWriteMode   "w"
                       ++ hasFmStr PF.ownerExecuteMode "x"
@ -532,6 +577,7 @@ packFileType file = case file of
  CharDev {}   -> "Char Device"
  NamedPipe {} -> "Named Pipe"
  Socket {}    -> "Socket"
+  _            -> "Unknown"


 packLinkDestination :: File a -> Maybe ByteString
@ -545,6 +591,24 @@ 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
+
--- a/src/HSFM/FileSystem/UtilTypes.hs
+++ b/src/HSFM/FileSystem/UtilTypes.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 OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}


@ -47,7 +48,7 @@ import HPath
  (
    Path
  , Abs
-  , Rel
+  , Fn
  )


@ -79,5 +80,5 @@ data FCollisonMode = Strict  -- ^ fail if the target already exists
                   | Overwrite
                   | OverwriteAll
                   | Skip
-                   | Rename (Path Rel)
+                   | Rename (Path Fn)

--- a/src/HSFM/GUI/Glib/GlibString.hs
+++ b/src/HSFM/GUI/Glib/GlibString.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 OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}


@ -66,7 +67,7 @@ instance GlibString BS.ByteString where
    newUTFStringLen = newUTFStringLen . toString
    genUTFOfs = genUTFOfs . toString
    stringLength = BS.length
-    unPrintf s = BS.intercalate (BS.pack [_percent, _percent]) (BS.split _percent s)
+    unPrintf s = BS.intercalate "%%" (BS.split _percent s)


 foreign import ccall unsafe "string.h strlen" c_strlen
--- a/src/HSFM/GUI/Gtk.hs
+++ b/src/HSFM/GUI/Gtk.hs
@ -16,52 +16,40 @@ 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
-  args <- SPE.getArgs
-  let mdir = fromMaybe (fromJust $ P.parseAbs slash)
-                       (P.parseAbs . headDef slash $ args)
-
-  file <- catchIOError (pathToFile getFileInfo mdir) $
-    \_ -> pathToFile getFileInfo  . fromJust $ P.parseAbs slash
-
  _ <- initGUI
+
+  args <- SPE.getArgs
+  let mdir = fromMaybe (fromJust $ P.parseAbs "/")
+                       (P.parseAbs . headDef "/" $ args)
+
  mygui <- createMyGUI
-  _ <- newTab mygui (notebook1 mygui) createTreeView file (-1)
-  _ <- newTab mygui (notebook2 mygui) createTreeView file (-1)
+  _ <- newTab mygui createTreeView mdir

  setGUICallbacks mygui

--- a/src/HSFM/GUI/Gtk/Callbacks.hs
+++ b/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 TupleSections #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}

 module HSFM.GUI.Gtk.Callbacks where
@ -32,21 +32,14 @@ import Control.Exception
  )
 import Control.Monad
  (
-    forM
-  , forM_
-  , join
+    forM_
  , void
  , when
  )
-import Control.Monad.IfElse
 import Control.Monad.IO.Class
  (
    liftIO
  )
-import Control.Monad.Loops
-  (
-    iterateUntil
-  )
 import Data.ByteString
  (
    ByteString
@ -63,45 +56,36 @@ import Data.Foldable
 import Graphics.UI.Gtk
 import qualified HPath as P
 import HPath
-  (
-    fromAbs
-  , Abs
-  , 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
-  )
+



@ -120,18 +104,6 @@ import Paths_hsfm
 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
@ -147,8 +119,8 @@ setGUICallbacks mygui = do

  -- key events
  _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
-    QuitModifier <- eventModifier
-    QuitKey      <- fmap glibToString eventKeyName
+    [Control] <- eventModifier
+    "q"       <- fmap glibToString eventKeyName
    liftIO mainQuit

  return ()
@ -203,45 +175,7 @@ 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
@ -249,68 +183,69 @@ 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
-        ShowHiddenModifier <- eventModifier
-        ShowHiddenKey      <- fmap glibToString eventKeyName
+        [Control] <- eventModifier
+        "h"       <- 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
-        UpDirModifier <- eventModifier
-        UpDirKey      <- fmap glibToString eventKeyName
+        [Alt] <- eventModifier
+        "Up"  <- fmap glibToString eventKeyName
        liftIO $ upDir mygui myview
      _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        HistoryBackModifier <- eventModifier
-        HistoryBackKey      <- fmap glibToString eventKeyName
-        liftIO $ void $ goHistoryBack mygui myview
+        [Alt] <- eventModifier
+        "Left"  <- fmap glibToString eventKeyName
+        liftIO $ goHistoryPrev mygui myview
      _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        HistoryForwardModifier <- eventModifier
-        HistoryForwardKey      <- fmap glibToString eventKeyName
-        liftIO $ void $ goHistoryForward mygui myview
+        [Alt] <- eventModifier
+        "Right"  <- fmap glibToString eventKeyName
+        liftIO $ goHistoryNext mygui myview
      _ <- view `on` keyPressEvent $ tryEvent $ do
-        DeleteModifier <- eventModifier
-        DeleteKey      <- fmap glibToString eventKeyName
+        "Delete"  <- fmap glibToString eventKeyName
        liftIO $ withItems mygui myview del
      _ <- view `on` keyPressEvent $ tryEvent $ do
-        OpenModifier <- eventModifier
-        OpenKey      <- fmap glibToString eventKeyName
+        []            <- eventModifier
+        "Return"      <- fmap glibToString eventKeyName
        liftIO $ withItems mygui myview open
      _ <- view `on` keyPressEvent $ tryEvent $ do
-        CopyModifier <- eventModifier
-        CopyKey      <- fmap glibToString eventKeyName
+        [Control] <- eventModifier
+        "c"       <- fmap glibToString eventKeyName
        liftIO $ withItems mygui myview copyInit
      _ <- view `on` keyPressEvent $ tryEvent $ do
-        MoveModifier <- eventModifier
-        MoveKey      <- fmap glibToString eventKeyName
+        [Control] <- eventModifier
+        "x"       <- fmap glibToString eventKeyName
        liftIO $ withItems mygui myview moveInit
      _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        PasteModifier <- eventModifier
-        PasteKey      <- fmap glibToString eventKeyName
+        [Control] <- eventModifier
+        "v"       <- fmap glibToString eventKeyName
        liftIO $ operationFinal mygui myview Nothing
      _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        NewTabModifier <- eventModifier
-        NewTabKey      <- fmap glibToString eventKeyName
-        liftIO $ void $ newTab' mygui myview
+        [Control] <- eventModifier
+        "t"       <- fmap glibToString eventKeyName
+        liftIO $ void $ do
+          cwd <- getCurrentDir myview
+          newTab mygui createTreeView (path cwd)
      _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        CloseTabModifier <- eventModifier
-        CloseTabKey      <- fmap glibToString eventKeyName
+        [Control] <- eventModifier
+        "w"       <- fmap glibToString eventKeyName
        liftIO $ void $ closeTab mygui myview
      _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        OpenTerminalModifier <- eventModifier
-        OpenTerminalKey      <- fmap glibToString eventKeyName
+        "F4"       <- fmap glibToString eventKeyName
        liftIO $ void $ openTerminalHere myview

-      -- mouse button click
+      -- righ-click
      _ <- view `on` buttonPressEvent $ do
        eb <- eventButton
        t  <- eventTime
        case eb of
          RightButton -> do
-              _ <- liftIO $ showPopup mygui myview t
+              _ <- liftIO $ menuPopup (rcMenu . rcmenu $ myview)
+                          $ Just (RightButton, t)
              -- this is just to not screw with current selection
              -- on right-click
              -- TODO: this misbehaves under IconView
@ -325,32 +260,42 @@ 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 $ void $ goHistoryBack mygui myview
+            liftIO $ goHistoryPrev mygui myview
            return False
          OtherButton 9 -> do
-            liftIO $ void $ goHistoryForward mygui myview
+            liftIO $ goHistoryNext 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
@ -369,7 +314,8 @@ setViewCallbacks mygui myview = do
 openTerminalHere :: MyView -> IO ProcessID
 openTerminalHere myview = do
  cwd <- (P.fromAbs . path) <$> getCurrentDir myview
-  SPP.forkProcess $ terminalCommand cwd
+  -- TODO: make terminal configurable
+  SPP.forkProcess $ SPP.executeFile "sakura" True ["-d", cwd] Nothing



@ -379,23 +325,9 @@ openTerminalHere myview = do

 -- |Closes the current tab, but only if there is more than one tab.
 closeTab :: MyGUI -> MyView -> IO ()
-closeTab _ myview = do
-  n <- notebookGetNPages (notebook 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 ()
+closeTab mygui myview = do
+  n <- notebookGetNPages (notebook mygui)
+  when (n > 1) $ void $ destroyView mygui myview



@ -414,7 +346,7 @@ del items@(_:_) _ _ = withErrorDialog $ do
  withConfirmationDialog cmsg
    $ forM_ items $ \item -> easyDelete . path $ item
 del _ _ _ = withErrorDialog
-              . ioError $ userError
+              . throwIO $ InvalidOperation
                          "Operation not supported on multiple files"


@ -429,7 +361,7 @@ moveInit items@(_:_) mygui _ = do
  popStatusbar mygui
  void $ pushStatusBar mygui sbmsg
 moveInit _ _ _ = withErrorDialog
-                   . ioError $ userError
+                   . throwIO $ InvalidOperation
                               "No file selected!"

 -- |Supposed to be used with 'withRows'. Initializes a file copy operation.
@ -443,7 +375,7 @@ copyInit items@(_:_) mygui _ = do
  popStatusbar mygui
  void $ pushStatusBar mygui sbmsg
 copyInit _ _ _ = withErrorDialog
-                   . ioError $ userError
+                   . throwIO $ InvalidOperation
                               "No file selected!"


@ -478,27 +410,27 @@ operationFinal mygui myview mitem = withErrorDialog $ do
 newFile :: MyGUI -> MyView -> IO ()
 newFile _ myview = withErrorDialog $ do
  mfn   <- textInputDialog "Enter file name" ("" :: String)
-  let pmfn = P.parseRel =<< fromString <$> mfn
+  let pmfn = P.parseFn =<< fromString <$> mfn
  for_ pmfn $ \fn -> do
    cdir  <- getCurrentDir myview
-    createRegularFile newFilePerms (path cdir P.</> fn)
+    createRegularFile (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.parseRel =<< fromString <$> mfn
+  let pmfn = P.parseFn =<< fromString <$> mfn
  for_ pmfn $ \fn -> do
    cdir  <- getCurrentDir myview
-    createDir newDirPerms (path cdir P.</> fn)
+    createDir (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.parseRel =<< fromString <$> mfn
+  let pmfn = P.parseFn =<< fromString <$> mfn
  for_ pmfn $ \fn -> do
    let cmsg = "Really rename \"" ++ getFPasStr item
               ++ "\"" ++ " to \""
@ -508,7 +440,7 @@ renameF [item] _ _ = withErrorDialog $ do
      HPath.IO.renameFile (path item)
                          ((P.dirname $ path item) P.</> fn)
 renameF _ _ _ = withErrorDialog
-                  . ioError $ userError
+                  . throwIO $ InvalidOperation
                              "Operation not supported on multiple files"


@ -526,15 +458,15 @@ urlGoTo mygui myview = withErrorDialog $ do
  fp <- entryGetText (urlBar myview)
  forM_ (P.parseAbs fp :: Maybe (Path Abs)) $ \fp' ->
      whenM (canOpenDirectory fp')
-            (goDir True mygui myview =<< (pathToFile getFileInfo $ fp'))
+            (goDir mygui myview =<< (readFile getFileInfo $ fp'))


 goHome :: MyGUI -> MyView -> IO ()
 goHome mygui myview =  withErrorDialog $ do
-  homedir <- home
-  forM_ (P.parseAbs homedir :: Maybe (Path Abs)) $ \fp' ->
+  mhomedir <- getEnv "HOME"
+  forM_ (P.parseAbs =<< mhomedir :: Maybe (Path Abs)) $ \fp' ->
      whenM (canOpenDirectory fp')
-            (goDir True mygui myview =<< (pathToFile getFileInfo $ fp'))
+            (goDir mygui myview =<< (readFile getFileInfo $ fp'))


 -- |Execute a given file.
@ -542,7 +474,7 @@ execute :: [Item] -> MyGUI -> MyView -> IO ()
 execute [item] _ _ = withErrorDialog $
  void $ executeFile (path item) []
 execute _ _ _ = withErrorDialog
-                  . ioError $ userError
+                  . throwIO $ InvalidOperation
                              "Operation not supported on multiple files"


@ -551,15 +483,16 @@ open :: [Item] -> MyGUI -> MyView -> IO ()
 open [item] mygui myview = withErrorDialog $
  case item of
    DirOrSym r -> do
-      nv <- pathToFile getFileInfo $ path r
-      goDir True mygui myview nv
+      nv <- readFile getFileInfo $ path r
+      goDir mygui myview nv
    r ->
      void $ openFile . path $ r
-open items mygui myview = do
-  let dirs  = filter (fst . sdir) items
-      files = filter (fst . sfileLike) items
-  forM_ dirs (withErrorDialog . opeInNewTab mygui myview)
-  forM_ files (withErrorDialog . openFile . path)
+-- this throws on the first error that occurs
+open (FileLikeList fs) _ _ = withErrorDialog $
+  forM_ fs $ \f -> void $ openFile . path $ f
+open _ _ _ = withErrorDialog
+               . throwIO $ InvalidOperation
+                           "Operation not supported on multiple files"


 -- |Go up one directory and visualize it in the treeView.
@ -567,162 +500,33 @@ upDir :: MyGUI -> MyView -> IO ()
 upDir mygui myview = withErrorDialog $ do
  cdir <- getCurrentDir myview
  nv <- goUp cdir
-  goDir True mygui myview nv
-
-
-
-
---- HISTORY CALLBACKS ----
+  goDir mygui myview nv


 -- |Go "back" in the history.
-goHistoryBack :: MyGUI -> MyView -> IO (Path Abs)
-goHistoryBack mygui myview = do
-  hs <- takeMVar (history myview)
-  let nhs = historyBack hs
-  putMVar (history myview) nhs
-  nv <- pathToFile getFileInfo $ currentDir nhs
-  goDir False mygui myview nv
-  return $ currentDir nhs
+goHistoryPrev :: MyGUI -> MyView -> IO ()
+goHistoryPrev mygui myview = do
+  hs <- readTVarIO (history myview)
+  case hs of
+    ([], _) -> return ()
+    (x:xs, _) -> do
+      cdir <- getCurrentDir myview
+      nv <- readFile getFileInfo $ x
+      modifyTVarIO (history myview)
+        (\(_, n) -> (xs, path cdir `addHistory` n))
+      refreshView' mygui myview nv


-- |Go "forward" in the history.
-goHistoryForward :: MyGUI -> MyView -> IO (Path Abs)
-goHistoryForward mygui myview = do
-  hs <- takeMVar (history myview)
-  let nhs = historyForward hs
-  putMVar (history myview) nhs
-  nv <- pathToFile getFileInfo $ currentDir nhs
-  goDir False mygui myview nv
-  return $ currentDir nhs
-
-
-- |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 {..}
+-- |Go "forth" in the history.
+goHistoryNext :: MyGUI -> MyView -> IO ()
+goHistoryNext mygui myview = do
+  hs <- readTVarIO (history myview)
+  case hs of
+    (_, []) -> return ()
+    (_, x:xs) -> do
+      cdir <- getCurrentDir myview
+      nv <- readFile getFileInfo $ x
+      modifyTVarIO (history myview)
+        (\(p, _) -> (path cdir `addHistory` p, xs))
+      refreshView' mygui myview nv

--- a/src/HSFM/GUI/Gtk/Callbacks/Utils.hs
+++ b/src/HSFM/GUI/Gtk/Callbacks/Utils.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 OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}

@ -25,16 +26,12 @@ module HSFM.GUI.Gtk.Callbacks.Utils where

 import Control.Monad
  (
-    forM_
-  , when
+    forM
+  , forM_
  )
-import Data.Foldable
+import Control.Monad.IO.Class
  (
-    for_
-  )
-import Data.Maybe
-  (
-    fromJust
+    liftIO
  )
 import GHC.IO.Exception
  (
@ -45,16 +42,19 @@ import qualified HPath as P
 import HPath.IO
 import HPath.IO.Errors
 import HSFM.FileSystem.FileType
-import qualified HSFM.FileSystem.UtilTypes as UT
+import HSFM.FileSystem.UtilTypes
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Dialogs
 import HSFM.GUI.Gtk.MyView
-import HSFM.History
-import Prelude hiding(readFile)
-import Control.Concurrent.MVar
+import HSFM.GUI.Gtk.Utils
+import HSFM.Utils.IO
  (
-    putMVar
-  , tryTakeMVar
+    modifyTVarIO
+  )
+import Prelude hiding(readFile)
+import Control.Concurrent.STM.TVar
+  (
+    readTVarIO
  )


@ -62,67 +62,49 @@ import Control.Concurrent.MVar

 -- |Carries out a file operation with the appropriate error handling
 -- allowing the user to react to various exceptions with further input.
-doFileOperation :: UT.FileOperation -> IO ()
-doFileOperation (UT.FCopy (UT.Copy (f':fs') to)) =
-  _doFileOperation (f':fs') to (\p1 p2 cm -> easyCopy p1 p2 cm FailEarly)
-    $ doFileOperation (UT.FCopy $ UT.Copy fs' to)
-doFileOperation (UT.FMove (UT.Move (f':fs') to)) =
-  _doFileOperation (f':fs') to moveFile
-    $ doFileOperation (UT.FMove $ UT.Move fs' to)
+doFileOperation :: FileOperation -> IO ()
+doFileOperation (FCopy (Copy (f':fs') to)) =
+  _doFileOperation (f':fs') to easyCopyOverwrite easyCopy
+    $ doFileOperation (FCopy $ Copy fs' to)
+doFileOperation (FMove (Move (f':fs') to)) =
+  _doFileOperation (f':fs') to moveFileOverwrite moveFile
+    $ doFileOperation (FMove $ Move fs' to)
 doFileOperation _ = return ()


 _doFileOperation :: [P.Path b1]
                 -> P.Path P.Abs
-                 -> (P.Path b1 -> P.Path P.Abs -> CopyMode -> IO b)
+                 -> (P.Path b1 -> P.Path P.Abs -> IO b)
+                 -> (P.Path b1 -> P.Path P.Abs -> IO a)
                 -> IO ()
                 -> IO ()
-_doFileOperation [] _ _ _ = return ()
-_doFileOperation (f:fs) to mc rest = do
+_doFileOperation [] _ _ _ _ = return ()
+_doFileOperation (f:fs) to mcOverwrite mc rest = do
  toname <- P.basename f
  let topath = to P.</> toname
-  reactOnError (mc f topath Strict >> rest)
-    -- TODO: how safe is 'AlreadyExists' here?
+  reactOnError (mc f topath >> rest)
    [(AlreadyExists  , collisionAction fileCollisionDialog topath)]
-    [(SameFile{}     , collisionAction renameDialog topath)]
+    [(FileDoesExist{}, collisionAction fileCollisionDialog 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
-        UT.Overwrite -> mc f topath Overwrite >> rest
-        UT.OverwriteAll -> forM_ (f:fs) $ \x -> do
+        Overwrite    -> mcOverwrite f topath >> rest
+        OverwriteAll -> forM_ (f:fs) $ \x -> do
                          toname' <- P.basename x
-                          mc x (to P.</> toname') Overwrite
-        UT.Skip         -> rest
-        UT.Rename newn  -> mc f (to P.</> newn) Strict >> rest
+                          mcOverwrite x (to P.</> toname')
+        Skip         -> rest
+        Rename newn  -> mc f (to P.</> newn) >> rest
        _            -> return ()


 -- |Helper that is invoked for any directory change operations.
-goDir :: Bool    -- ^ whether to update the history
-      -> MyGUI
-      -> MyView
-      -> Item
-      -> IO ()
-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)
+goDir :: MyGUI -> MyView -> Item -> IO ()
+goDir mygui myview item = do
+  cdir <- getCurrentDir myview
+  modifyTVarIO (history myview)
+    (\(p, _) -> (path cdir `addHistory` p, []))
+  refreshView' mygui myview item

--- a/src/HSFM/GUI/Gtk/Data.hs
+++ b/src/HSFM/GUI/Gtk/Data.hs
@ -30,9 +30,13 @@ 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
@ -57,14 +61,7 @@ data MyGUI = MkMyGUI {
  , menubar        :: !MenuBar
  , statusBar      :: !Statusbar
  , clearStatusBar :: !Button
-
-  , notebook1      :: !Notebook
-  , leftNbBtn      :: !ToggleButton
-  , leftNbIcon     :: !Image
-
-  , notebook2      :: !Notebook
-  , rightNbBtn     :: !ToggleButton
-  , rightNbIcon    :: !Image
+  , notebook       :: !Notebook

  -- other
  , fprop    :: !FilePropertyGrid
@ -83,18 +80,16 @@ 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         :: !(MVar BrowsingHistory)
+  , history         :: !(TVar ([Path Abs], [Path Abs]))

  -- sub-widgets
  , scroll       :: !ScrolledWindow
  , viewBox      :: !Box
-  , backViewB    :: !Button
+  , rcmenu       :: !RightClickMenu
  , upViewB      :: !Button
-  , forwardViewB :: !Button
  , homeViewB    :: !Button
  , refreshViewB :: !Button
  , urlBar       :: !Entry
@ -112,8 +107,6 @@ data RightClickMenu = MkRightClickMenu {
  , rcFileExecute    :: !ImageMenuItem
  , rcFileNewRegFile :: !ImageMenuItem
  , rcFileNewDir     :: !ImageMenuItem
-  , rcFileNewTab     :: !ImageMenuItem
-  , rcFileNewTerm    :: !ImageMenuItem
  , rcFileCut        :: !ImageMenuItem
  , rcFileCopy       :: !ImageMenuItem
  , rcFileRename     :: !ImageMenuItem
--- a/src/HSFM/GUI/Gtk/Dialogs.hs
+++ b/src/HSFM/GUI/Gtk/Dialogs.hs
@ -16,22 +16,21 @@ 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
+import Control.Applicative
  (
-    decodeString
+    (<$>)
  )
 import Control.Exception
  (
-    catches
-  , displayException
+    displayException
  , throwIO
  , IOException
+  , catches
  , Handler(..)
  )
 import Control.Monad
@ -49,39 +48,23 @@ 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
  )
-#endif
+import Distribution.Package
+  (
+    PackageIdentifier(..)
+  , PackageName(..)
+  )
 import Distribution.PackageDescription
  (
    GenericPackageDescription(..)
  , PackageDescription(..)
  )
-#if MIN_VERSION_Cabal(2,2,0)
-import Distribution.PackageDescription.Parsec
-#else
 import Distribution.PackageDescription.Parse
-#endif
  (
-#if MIN_VERSION_Cabal(2,0,0)
-    readGenericPackageDescription,
-#else
-    readPackageDescription,
-#endif
+    readPackageDescription
  )
 import Distribution.Verbosity
  (
@ -114,6 +97,7 @@ import System.Posix.FilePath



+
    ---------------------
    --[ Dialog popups ]--
    ---------------------
@ -171,7 +155,7 @@ fileCollisionDialog t = do
    ResponseUser 4 -> do
      mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
      forM mfn $ \fn -> do
-        pfn <- P.parseRel (fromString fn)
+        pfn <- P.parseFn (fromString fn)
        return $ Rename pfn
    _              -> throwIO UnknownDialogButton

@ -196,7 +180,7 @@ renameDialog t = do
    ResponseUser 2 -> do
      mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
      forM mfn $ \fn -> do
-        pfn <- P.parseRel (fromString fn)
+        pfn <- P.parseFn (fromString fn)
        return $ Rename pfn
    _              -> throwIO UnknownDialogButton

@ -208,16 +192,12 @@ 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 . packageVersion . package) pdesc
+    , aboutDialogVersion      := (showVersion . pkgVersion . package) pdesc
    , aboutDialogCopyright    := copyright pdesc
    , aboutDialogComments     := description pdesc
    , aboutDialogLicense      := Just lstr
@ -244,9 +224,7 @@ withErrorDialog :: IO a -> IO ()
 withErrorDialog io =
  catches (void io)
    [ Handler (\e -> showErrorDialog
-                       . decodeString
-                       . displayException
-                       $ (e :: IOException))
+                       $ displayException (e :: IOException))
    , Handler (\e -> showErrorDialog
                       $ displayException (e :: HPathIOException))
    ]
@ -254,9 +232,9 @@ withErrorDialog io =

 -- |Asks the user which directory copy mode he wants via dialog popup
 -- and returns 'DirCopyMode'.
-textInputDialog :: (GlibString s1, GlibString s2)
-                => s1   -- ^ window title
-                -> s2   -- ^ initial text in input widget
+textInputDialog :: GlibString string
+                => string   -- ^ window title
+                -> string   -- ^ initial text in input widget
                -> IO (Maybe String)
 textInputDialog title inittext = do
  chooserDialog <- messageDialogNew Nothing
@ -295,7 +273,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')  (show . fileSize $ fvar item)
+  entrySetText (fpropTsEntry fprop')  (fromFreeVar (show . fileSize) item)
  entrySetText (fpropModEntry fprop') (packModTime item)
  entrySetText (fpropAcEntry fprop')  (packAccessTime item)
  entrySetText (fpropFTEntry fprop')  (packFileType item)
--- a/src/HSFM/GUI/Gtk/Errors.hs
+++ b/src/HSFM/GUI/Gtk/Errors.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 DeriveDataTypeable #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}

 -- |Provides error handling for Gtk.
--- a/src/HSFM/GUI/Gtk/Icons.hs
+++ b/src/HSFM/GUI/Gtk/Icons.hs
@ -22,6 +22,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 module HSFM.GUI.Gtk.Icons where


+import Control.Applicative
+  (
+    (<$>)
+  )
 import Data.Maybe
  (
    fromJust
--- a/src/HSFM/GUI/Gtk/MyGUI.hs
+++ b/src/HSFM/GUI/Gtk/MyGUI.hs
@ -45,6 +45,7 @@ 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
@ -81,32 +82,8 @@ createMyGUI = do
                       "fpropPermEntry"
  fpropLDEntry      <- builderGetObject builder castToEntry
                       "fpropLDEntry"
-  notebook1         <- builderGetObject builder castToNotebook
-                       "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
+  notebook          <- builderGetObject builder castToNotebook
+                       "notebook"

  -- construct the gui object
  let menubar = MkMenuBar {..}
--- a/src/HSFM/GUI/Gtk/MyView.hs
+++ b/src/HSFM/GUI/Gtk/MyView.hs
@ -16,12 +16,15 @@ 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


+import Control.Applicative
+  (
+    (<$>)
+  )
 import Control.Concurrent.MVar
  (
    newEmptyMVar
@ -33,16 +36,16 @@ import Control.Concurrent.STM
    newTVarIO
  , readTVarIO
  )
+import Control.Exception
+  (
+    try
+  , SomeException
+  )
 import Control.Monad
  (
-    unless
-  , void
-  , when
-  )
-import Control.Monad.IO.Class
-  (
-    liftIO
+    forM_
  )
+import qualified Data.ByteString as BS
 import Data.Foldable
  (
    for_
@ -52,19 +55,23 @@ import Data.Maybe
    catMaybes
  , fromJust
  )
-import Data.String
+import HPath.IO.Errors
  (
-    fromString
+    canOpenDirectory
  )
 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
  (
@ -78,72 +85,36 @@ import System.INotify
  , killINotify
  , EventVariety(..)
  )
-import System.IO.Error
-  (
-    catchIOError
-  , ioError
-  , isUserError
-  )
 import System.Posix.FilePath
  (
-    hiddenFile
+    pathSeparator
+  , hiddenFile
  )



 -- |Creates a new tab with its own view and refreshes the view.
-newTab :: MyGUI -> Notebook -> IO FMView -> Item -> Int -> IO MyView
-newTab mygui nb iofmv item pos = do
-
-
-  -- create eventbox with label
-  label <- labelNewWithMnemonic
-    (maybe (P.fromAbs $ path item) P.fromRel $ P.basename $ path item)
-  ebox <- eventBoxNew
-  eventBoxSetVisibleWindow ebox False
-  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
-
+newTab :: MyGUI -> IO FMView -> Path Abs -> IO MyView
+newTab mygui iofmv path = do
+  myview <- createMyView mygui iofmv
+  i <- notebookAppendPage (notebook mygui) (viewBox myview)
+       (maybe (P.fromAbs path) P.fromRel $ P.basename path)
+  mpage <- notebookGetNthPage (notebook mygui) i
+  forM_ mpage $ \page -> notebookSetTabReorderable (notebook mygui)
+                                                   page
+                                                   True
+  refreshView mygui myview (Just path)
  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 nb iofmv = do
+createMyView mygui iofmv = do
  inotify <- newEmptyMVar
-  history <- newEmptyMVar
+  history <- newTVarIO ([],[])

  builder <- builderNew
  builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
@ -160,13 +131,34 @@ createMyView mygui nb iofmv = do

  urlBar            <- builderGetObject builder castToEntry
                       "urlBar"
-
-  backViewB         <- builderGetObject builder castToButton
-                       "backViewB"
+  rcMenu            <- builderGetObject builder castToMenu
+                       "rcMenu"
+  rcFileOpen        <- builderGetObject builder castToImageMenuItem
+                       "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
@ -176,7 +168,7 @@ createMyView mygui nb iofmv = do
  viewBox           <- builderGetObject builder castToBox
                         "viewBox"

-  let notebook = nb
+  let rcmenu = MkRightClickMenu {..}
  let myview = MkMyView {..}

  -- set the bindings
@ -197,38 +189,37 @@ switchView :: MyGUI -> MyView -> IO FMView -> IO ()
 switchView mygui myview iofmv = do
  cwd <- getCurrentDir myview

-  let nb = notebook myview
-
-  oldpage <- destroyView myview
+  oldpage <- destroyView mygui myview

  -- create new view and tab page where the previous one was
-  nview <- newTab mygui nb iofmv cwd oldpage
+  nview <- createMyView mygui iofmv
+  newpage <- notebookInsertPage (notebook mygui) (viewBox nview)
+             (maybe (P.fromAbs $ path cwd) P.fromRel
+                 $ P.basename . path $ cwd) oldpage
+  notebookSetCurrentPage (notebook mygui) newpage

-  page <- fromJust <$> notebookPageNum nb (viewBox nview)
-  notebookSetCurrentPage nb page
-
-  refreshView mygui nview cwd
+  refreshView' mygui nview cwd


-- |Destroys the given view by disconnecting the watcher
+-- |Destroys the current 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 :: MyView -> IO Int
-destroyView myview = do
+destroyView :: MyGUI -> MyView -> IO Int
+destroyView mygui myview = do
  -- disconnect watcher
  mi <- tryTakeMVar (inotify myview)
  for_ mi $ \i -> killINotify i

-  page <- fromJust <$> notebookPageNum (notebook myview) (viewBox myview)
+  page <- notebookGetCurrentPage (notebook mygui)

  -- destroy old view and tab page
  view' <- readTVarIO $ view myview
  widgetDestroy (fmViewToContainer view')
-  notebookRemovePage (notebook myview) page
+  notebookRemovePage (notebook mygui) page

  return page

@ -304,18 +295,46 @@ 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.
 --
-- Throws:
--
--   - `userError` on inappropriate type
-refreshView :: MyGUI
+-- If the directory is not a Dir or a Symlink pointing to a Dir, then
+-- calls `refreshView` with the 3rd argument being Nothing.
+refreshView' :: MyGUI
             -> MyView
             -> Item
             -> IO ()
-refreshView mygui myview SymLink { sdest = Just d@Dir{} } =
-  refreshView mygui myview d
-refreshView mygui myview item@Dir{} = do
+refreshView' mygui myview SymLink { sdest = d@Dir{} } =
+  refreshView' mygui myview d
+refreshView' mygui myview item@Dir{} = do
  newRawModel  <- fileListStore item myview
  writeTVarIO (rawModel myview) newRawModel

@ -330,6 +349,12 @@ 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
@ -338,7 +363,8 @@ refreshView mygui myview item@Dir{} = do
      ntps <- mapM treeRowReferenceGetPath trs
      mapM_ (treeSelectionSelectPath tvs) ntps
    _ -> return ()
-refreshView _ _ _ = ioError $ userError "Inappropriate type!"
+refreshView' mygui myview Failed{} = refreshView mygui myview Nothing
+refreshView' _ _ _ = return ()


 -- |Constructs the visible View with the current underlying mutable models,
@ -363,14 +389,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

-  cdir <- getCurrentDir myview
-  let cdirp = path cdir
+  cdirp <- path <$> getCurrentDir myview

  -- update urlBar
  entrySetText (urlBar myview) (P.fromAbs cdirp)
@ -411,7 +437,7 @@ constructView mygui myview = do
  -- update model of view
  case view' of
    FMTreeView treeView -> do
-      treeViewSetModel treeView (Just sortedModel')
+      treeViewSetModel treeView sortedModel'
      treeViewSetRubberBanding treeView True
    FMIconView iconView -> do
      iconViewSetModel iconView (Just sortedModel')
@ -428,7 +454,7 @@ constructView mygui myview = do
         newi
         [Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
         (P.fromAbs cdirp)
-         (\_ -> postGUIAsync $ refreshView mygui myview cdir)
+         (\_ -> postGUIAsync $ refreshView mygui myview (Just $ cdirp))
  putMVar (inotify myview) newi

  return ()
--- a/src/HSFM/GUI/Gtk/Plugins.hs
+++ b/src/HSFM/GUI/Gtk/Plugins.hs
@ -1,112 +0,0 @@
-{--
-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
-
--- a/src/HSFM/GUI/Gtk/Settings.hs
+++ b/src/HSFM/GUI/Gtk/Settings.hs
@ -1,128 +0,0 @@
-{--
-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"
-
--- a/src/HSFM/GUI/Gtk/Utils.hs
+++ b/src/HSFM/GUI/Gtk/Utils.hs
@ -21,6 +21,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 module HSFM.GUI.Gtk.Utils where


+import Control.Applicative
+  (
+    (<$>)
+  )
 import Control.Concurrent.MVar
  (
    readMVar
@ -78,8 +82,8 @@ withItems :: MyGUI
          -> (   [Item]
              -> MyGUI
              -> MyView
-              -> IO a) -- ^ action to carry out
-          -> IO a
+              -> IO ()) -- ^ action to carry out
+          -> IO ()
 withItems mygui myview io = do
  items <- getSelectedItems mygui myview
  io items mygui myview
@ -152,3 +156,15 @@ 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
+
--- a/src/HSFM/History.hs
+++ b/src/HSFM/History.hs
@ -1,61 +0,0 @@
-{--
-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
-
--- a/src/HSFM/Settings.hs
+++ b/src/HSFM/Settings.hs
@ -1,67 +0,0 @@
-{--
-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")
-
--- a/src/HSFM/Utils/MyPrelude.hs
+++ b/src/HSFM/Utils/MyPrelude.hs
@ -19,6 +19,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 module HSFM.Utils.MyPrelude where


+import Data.Default
 import Data.List


@ -30,3 +31,6 @@ 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
--- a/update-gh-pages.sh
+++ b/update-gh-pages.sh
@ -1,52 +0,0 @@
-#!/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
-
--- a/update-index-state.sh
+++ b/update-index-state.sh
@ -1,66 +0,0 @@
-#!/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
-
Author	SHA1	Message	Date
Julian Ospald	676cc3964a	Skip build with 7.8.4, which has annoying failures	2016-05-30 14:40:23 +02:00
Julian Ospald	d13019bc83	Fix base and cabal version constraints	2016-05-30 14:40:03 +02:00
Julian Ospald	93cfdaa6a7	Update HACKING.md	2016-05-30 14:37:15 +02:00
Julian Ospald	d1432c206b	Fix build for ghc < 7.10	2016-05-30 14:20:00 +02:00
Julian Ospald	6839715e96	Fix travis	2016-05-30 13:56:02 +02:00
Julian Ospald	e900b690e7	Fix build with older GHC < 7.10	2016-05-30 13:52:37 +02:00
Julian Ospald	ba398d348e	Fix travis	2016-05-30 13:31:08 +02:00
Julian Ospald	0e12d4c452	Fix travis	2016-05-30 13:30:22 +02:00
Julian Ospald	af95c1ecfb	Fix travis	2016-05-30 13:18:56 +02:00
Julian Ospald	f6a9c46c9a	Fix travis	2016-05-30 13:18:00 +02:00
Julian Ospald	588207f44b	Fix travis	2016-05-30 13:15:11 +02:00
Julian Ospald	f2eca58b5d	Require cabal >= 1.24	2016-05-30 13:05:14 +02:00
Julian Ospald	723042d9b9	Fix .cabal file This fixes 'cabal check' warnings.	2016-05-30 12:39:49 +02:00
Julian Ospald	219b4a7ebb	Fix travis build	2016-05-30 12:18:32 +02:00
Julian Ospald	42afd6983e	Not that experimental anymore	2016-05-30 01:08:27 +02:00
Julian Ospald	5266c9d2b4	Add travis	2016-05-30 01:03:29 +02:00