Add Settings modules wrt #22

This commit is contained in:
Julian Ospald 2016-06-07 20:07:16 +02:00
parent f6ec802898
commit 89710d9d1a
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
4 changed files with 228 additions and 32 deletions

View File

@ -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

View File

@ -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'))

View File

@ -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"

67
src/HSFM/Settings.hs Normal file
View File

@ -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"