From 89710d9d1aaff0e85a76e36ff92977ff8712b049 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 7 Jun 2016 20:07:16 +0200 Subject: [PATCH] Add Settings modules wrt #22 --- hsfm.cabal | 2 + src/HSFM/GUI/Gtk/Callbacks.hs | 63 ++++++++--------- src/HSFM/GUI/Gtk/Settings.hs | 128 ++++++++++++++++++++++++++++++++++ src/HSFM/Settings.hs | 67 ++++++++++++++++++ 4 files changed, 228 insertions(+), 32 deletions(-) create mode 100644 src/HSFM/GUI/Gtk/Settings.hs create mode 100644 src/HSFM/Settings.hs diff --git a/hsfm.cabal b/hsfm.cabal index b2ff9c2..a9d21ff 100644 --- a/hsfm.cabal +++ b/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 diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index 993394a..8fd394c 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/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 - "q" <- fmap glibToString eventKeyName + QuitModifier <- eventModifier + 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 - "h" <- fmap glibToString eventKeyName + ShowHiddenModifier <- eventModifier + 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 - "Up" <- fmap glibToString eventKeyName + UpDirModifier <- eventModifier + UpDirKey <- fmap glibToString eventKeyName liftIO $ upDir mygui myview _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do - [Alt] <- eventModifier - "Left" <- fmap glibToString eventKeyName + HistoryBackModifier <- eventModifier + HistoryBackKey <- fmap glibToString eventKeyName liftIO $ void $ goHistoryBack mygui myview _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do - [Alt] <- eventModifier - "Right" <- fmap glibToString eventKeyName + HistoryForwardModifier <- eventModifier + 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 - "Return" <- fmap glibToString eventKeyName + OpenModifier <- eventModifier + OpenKey <- fmap glibToString eventKeyName liftIO $ withItems mygui myview open _ <- view `on` keyPressEvent $ tryEvent $ do - [Control] <- eventModifier - "c" <- fmap glibToString eventKeyName + CopyModifier <- eventModifier + CopyKey <- fmap glibToString eventKeyName liftIO $ withItems mygui myview copyInit _ <- view `on` keyPressEvent $ tryEvent $ do - [Control] <- eventModifier - "x" <- fmap glibToString eventKeyName + MoveModifier <- eventModifier + MoveKey <- fmap glibToString eventKeyName liftIO $ withItems mygui myview moveInit _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do - [Control] <- eventModifier - "v" <- fmap glibToString eventKeyName + PasteModifier <- eventModifier + PasteKey <- fmap glibToString eventKeyName liftIO $ operationFinal mygui myview Nothing _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do - [Control] <- eventModifier - "t" <- fmap glibToString eventKeyName + NewTabModifier <- eventModifier + NewTabKey <- fmap glibToString eventKeyName liftIO $ void $ newTab' mygui myview _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do - [Control] <- eventModifier - "w" <- fmap glibToString eventKeyName + CloseTabModifier <- eventModifier + 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 $ SPP.executeFile "sakura" True ["-d", cwd] Nothing + SPP.forkProcess $ terminalCommand cwd @@ -535,8 +534,8 @@ urlGoTo mygui myview = withErrorDialog $ do goHome :: MyGUI -> MyView -> IO () goHome mygui myview = withErrorDialog $ do - mhomedir <- getEnv "HOME" - forM_ (P.parseAbs =<< mhomedir :: Maybe (Path Abs)) $ \fp' -> + homedir <- home + forM_ (P.parseAbs homedir :: Maybe (Path Abs)) $ \fp' -> whenM (canOpenDirectory fp') (goDir True mygui myview =<< (readFile getFileInfo $ fp')) diff --git a/src/HSFM/GUI/Gtk/Settings.hs b/src/HSFM/GUI/Gtk/Settings.hs new file mode 100644 index 0000000..9b3ab2d --- /dev/null +++ b/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" + diff --git a/src/HSFM/Settings.hs b/src/HSFM/Settings.hs new file mode 100644 index 0000000..9e18886 --- /dev/null +++ b/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" +