Add Settings modules wrt #22

hsfm.cabal

@@ -27,6 +27,7 @@ library
                        HSFM.FileSystem.FileType
                        HSFM.FileSystem.UtilTypes
                        HSFM.History
+                       HSFM.Settings
                        HSFM.Utils.IO
                        HSFM.Utils.MyPrelude
 
@@ -63,6 +64,7 @@ executable hsfm-gtk
                        HSFM.GUI.Gtk.Icons
                        HSFM.GUI.Gtk.MyGUI
                        HSFM.GUI.Gtk.MyView
+                       HSFM.GUI.Gtk.Settings
                        HSFM.GUI.Gtk.Utils
                        HSFM.Utils.MyPrelude
 

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -76,18 +76,16 @@ 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.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
   (
@@ -133,8 +131,8 @@ setGUICallbacks mygui = do
 
   -- key events
   _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
-    [Control] <- eventModifier
+    QuitModifier <- eventModifier
-    "q"       <- fmap glibToString eventKeyName
+    QuitKey      <- fmap glibToString eventKeyName
     liftIO mainQuit
 
   return ()
@@ -229,53 +227,55 @@ setViewCallbacks mygui myview = do
 
       -- key events
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        ShowHiddenModifier <- eventModifier
-        "h"       <- fmap glibToString eventKeyName
+        ShowHiddenKey      <- fmap glibToString eventKeyName
         cdir <- liftIO $ getCurrentDir myview
         liftIO $ modifyTVarIO (settings mygui)
                               (\x -> x { showHidden = not . showHidden $ x})
                  >> refreshView mygui myview cdir
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Alt] <- eventModifier
+        UpDirModifier <- eventModifier
-        "Up"  <- fmap glibToString eventKeyName
+        UpDirKey      <- fmap glibToString eventKeyName
         liftIO $ upDir mygui myview
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Alt] <- eventModifier
+        HistoryBackModifier <- eventModifier
-        "Left"  <- fmap glibToString eventKeyName
+        HistoryBackKey      <- fmap glibToString eventKeyName
         liftIO $ void $ goHistoryBack mygui myview
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Alt] <- eventModifier
+        HistoryForwardModifier <- eventModifier
-        "Right"  <- fmap glibToString eventKeyName
+        HistoryForwardKey      <- fmap glibToString eventKeyName
         liftIO $ void $ goHistoryForward mygui myview
       _ <- view `on` keyPressEvent $ tryEvent $ do
-        "Delete"  <- fmap glibToString eventKeyName
+        DeleteModifier <- eventModifier
+        DeleteKey      <- fmap glibToString eventKeyName
         liftIO $ withItems mygui myview del
       _ <- view `on` keyPressEvent $ tryEvent $ do
-        []            <- eventModifier
+        OpenModifier <- eventModifier
-        "Return"      <- fmap glibToString eventKeyName
+        OpenKey      <- fmap glibToString eventKeyName
         liftIO $ withItems mygui myview open
       _ <- view `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        CopyModifier <- eventModifier
-        "c"       <- fmap glibToString eventKeyName
+        CopyKey      <- fmap glibToString eventKeyName
         liftIO $ withItems mygui myview copyInit
       _ <- view `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        MoveModifier <- eventModifier
-        "x"       <- fmap glibToString eventKeyName
+        MoveKey      <- fmap glibToString eventKeyName
         liftIO $ withItems mygui myview moveInit
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        PasteModifier <- eventModifier
-        "v"       <- fmap glibToString eventKeyName
+        PasteKey      <- fmap glibToString eventKeyName
         liftIO $ operationFinal mygui myview Nothing
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        NewTabModifier <- eventModifier
-        "t"       <- fmap glibToString eventKeyName
+        NewTabKey      <- fmap glibToString eventKeyName
         liftIO $ void $ newTab' mygui myview
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        [Control] <- eventModifier
+        CloseTabModifier <- eventModifier
-        "w"       <- fmap glibToString eventKeyName
+        CloseTabKey      <- fmap glibToString eventKeyName
         liftIO $ void $ closeTab mygui myview
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
-        "F4"       <- fmap glibToString eventKeyName
+        OpenTerminalModifier <- eventModifier
+        OpenTerminalKey      <- fmap glibToString eventKeyName
         liftIO $ void $ openTerminalHere myview
 
       -- mouse button click
@@ -374,8 +374,7 @@ setViewCallbacks mygui myview = do
 openTerminalHere :: MyView -> IO ProcessID
 openTerminalHere myview = do
   cwd <- (P.fromAbs . path) <$> getCurrentDir myview
-  -- TODO: make terminal configurable
+  SPP.forkProcess $ terminalCommand cwd
-  SPP.forkProcess $ SPP.executeFile "sakura" True ["-d", cwd] Nothing
 
 
 
@@ -535,8 +534,8 @@ urlGoTo mygui myview = withErrorDialog $ do
 
 goHome :: MyGUI -> MyView -> IO ()
 goHome mygui myview =  withErrorDialog $ do
-  mhomedir <- getEnv "HOME"
+  homedir <- home
-  forM_ (P.parseAbs =<< mhomedir :: Maybe (Path Abs)) $ \fp' ->
+  forM_ (P.parseAbs homedir :: Maybe (Path Abs)) $ \fp' ->
       whenM (canOpenDirectory fp')
             (goDir True mygui myview =<< (readFile getFileInfo $ fp'))
 

src/HSFM/GUI/Gtk/Settings.hs

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

src/HSFM/Settings.hs

@@ -0,0 +1,67 @@
+{--
+HSFM, a filemanager written in Haskell.
+Copyright (C) 2016 Julian Ospald
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+version 2 as published by the Free Software Foundation.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+--}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_HADDOCK ignore-exports #-}
+
+
+module HSFM.Settings where
+
+
+import Data.ByteString
+  (
+    ByteString
+  )
+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
+    "sakura"    -- the terminal command
+    True        -- whether to search PATH
+    ["-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 "/" <*> getEnv "HOME"
+