Add Settings modules wrt #22
This commit is contained in:
parent
f6ec802898
commit
89710d9d1a
@ -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
|
||||
|
||||
|
||||
@ -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'))
|
||||
|
||||
|
||||
128
src/HSFM/GUI/Gtk/Settings.hs
Normal file
128
src/HSFM/GUI/Gtk/Settings.hs
Normal 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
67
src/HSFM/Settings.hs
Normal 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"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user