{-# LANGUAGE CPP #-}
module Termonad.Preferences
( module Termonad.Preferences.File
, showPreferencesDialog
) where
import Termonad.Prelude
import Control.Lens ((^.), over, set, view)
import qualified Data.List as List
import qualified Data.Text as Text
import GI.Gtk
( CheckButton(CheckButton)
, ComboBoxText(ComboBoxText)
, Dialog(Dialog)
, Entry(Entry)
, FontButton(FontButton)
, Label(Label)
, PolicyType(PolicyTypeAutomatic)
, ResponseType(ResponseTypeAccept)
, SpinButton(SpinButton)
, adjustmentNew
, applicationGetActiveWindow
, applicationWindowSetShowMenubar
, builderNewFromString
, comboBoxGetActiveId
, comboBoxSetActiveId
, comboBoxTextAppend
, dialogRun
, entryBufferGetText
, entryBufferSetText
, fontChooserSetFontDesc
, fontChooserGetFontDesc
, getEntryBuffer
, scrolledWindowSetPolicy
, spinButtonGetValueAsInt
, spinButtonSetAdjustment
, spinButtonSetValue
, toggleButtonGetActive
, toggleButtonSetActive
, widgetDestroy
, widgetSetVisible
, windowSetTransientFor
)
import GI.Vte
( CursorBlinkMode(..)
, terminalSetBoldIsBright
, terminalSetCursorBlinkMode
, terminalSetFont
, terminalSetScrollbackLines
, terminalSetWordCharExceptions
, terminalSetAllowBold
)
import System.Environment (getExecutablePath)
import System.FilePath (takeFileName)
import Termonad.Gtk (objFromBuildUnsafe, terminalSetEnableSixelIfExists)
import Termonad.Lenses
( lensBoldIsBright
, lensEnableSixel
, lensAllowBold
, lensConfirmExit
, lensCursorBlinkMode
, lensFontConfig
, lensOptions
, lensShowMenu
, lensShowScrollbar
, lensShowTabBar
, lensScrollbackLen
, lensTMNotebookTabTermContainer
, lensTMNotebookTabTerm
, lensTMStateApp
, lensTMStateConfig
, lensTMStateFontDesc
, lensTerm
, lensWordCharExceptions
)
import Termonad.Preferences.File (saveToPreferencesFile, tmConfigFromPreferencesFile)
import Termonad.Term
( setShowTabs
, showScrollbarToPolicy
)
import Termonad.Types
( ConfigOptions(..)
, ShowScrollbar(..)
, ShowTabBar(..)
, TMNotebookTab
, TMState
, TMWindowId
, fontConfigFromFontDescription
, getTMWindowFromTMState'
, tmNotebook
, tmNotebookTabs
, tmStateWindows
, tmWindowAppWin
, tmWindowNotebook
)
import Termonad.XML (preferencesText)
import Termonad.IdMap (keysIdMap)
comboBoxFill :: forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
comboBoxFill :: forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
comboBoxFill ComboBoxText
comboBox = ((a, Text) -> IO ()) -> [(a, Text)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (a, Text) -> IO ()
go
where
go :: (a, Text) -> IO ()
go :: (a, Text) -> IO ()
go (a
value, Text
textId) =
ComboBoxText -> Maybe Text -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsComboBoxText a) =>
a -> Maybe Text -> Text -> m ()
comboBoxTextAppend ComboBoxText
comboBox (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. Show a => a -> Text
tshow a
value) Text
textId
comboBoxSetActive :: Show a => ComboBoxText -> a -> IO ()
comboBoxSetActive :: forall a. Show a => ComboBoxText -> a -> IO ()
comboBoxSetActive ComboBoxText
cb a
item = IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ ComboBoxText -> Maybe Text -> IO Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsComboBox a) =>
a -> Maybe Text -> m Bool
comboBoxSetActiveId ComboBoxText
cb (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. Show a => a -> Text
tshow a
item)
comboBoxGetActive
:: forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
comboBoxGetActive :: forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
comboBoxGetActive ComboBoxText
cb [a]
values = Maybe Text -> Maybe a
findEnumFromMaybeId (Maybe Text -> Maybe a) -> IO (Maybe Text) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComboBoxText -> IO (Maybe Text)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsComboBox a) =>
a -> m (Maybe Text)
comboBoxGetActiveId ComboBoxText
cb
where
findEnumFromMaybeId :: Maybe Text -> Maybe a
findEnumFromMaybeId :: Maybe Text -> Maybe a
findEnumFromMaybeId Maybe Text
maybeId = Maybe Text
maybeId Maybe Text -> (Text -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe a
findEnumFromId
findEnumFromId :: Text -> Maybe a
findEnumFromId :: Text -> Maybe a
findEnumFromId Text
label = (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\a
x -> a -> Text
forall a. Show a => a -> Text
tshow a
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
label) [a]
values
applyNewPreferencesToTab :: TMState -> TMNotebookTab -> IO ()
applyNewPreferencesToTab :: TMState -> TMNotebookTab -> IO ()
applyNewPreferencesToTab TMState
mvarTMState TMNotebookTab
tab = do
TMState'
tmState <- TMState -> IO TMState'
forall a. MVar a -> IO a
readMVar TMState
mvarTMState
let fontDesc :: FontDescription
fontDesc = TMState'
tmState TMState'
-> Getting FontDescription TMState' FontDescription
-> FontDescription
forall s a. s -> Getting a s a -> a
^. Getting FontDescription TMState' FontDescription
Lens' TMState' FontDescription
lensTMStateFontDesc
term :: Terminal
term = TMNotebookTab
tab TMNotebookTab
-> Getting Terminal TMNotebookTab Terminal -> Terminal
forall s a. s -> Getting a s a -> a
^. (TMTerm -> Const Terminal TMTerm)
-> TMNotebookTab -> Const Terminal TMNotebookTab
Lens' TMNotebookTab TMTerm
lensTMNotebookTabTerm ((TMTerm -> Const Terminal TMTerm)
-> TMNotebookTab -> Const Terminal TMNotebookTab)
-> ((Terminal -> Const Terminal Terminal)
-> TMTerm -> Const Terminal TMTerm)
-> Getting Terminal TMNotebookTab Terminal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Terminal -> Const Terminal Terminal)
-> TMTerm -> Const Terminal TMTerm
Lens' TMTerm Terminal
lensTerm
scrolledWin :: ScrolledWindow
scrolledWin = TMNotebookTab
tab TMNotebookTab
-> Getting ScrolledWindow TMNotebookTab ScrolledWindow
-> ScrolledWindow
forall s a. s -> Getting a s a -> a
^. Getting ScrolledWindow TMNotebookTab ScrolledWindow
Lens' TMNotebookTab ScrolledWindow
lensTMNotebookTabTermContainer
options :: ConfigOptions
options = TMState'
tmState TMState'
-> Getting ConfigOptions TMState' ConfigOptions -> ConfigOptions
forall s a. s -> Getting a s a -> a
^. (TMConfig -> Const ConfigOptions TMConfig)
-> TMState' -> Const ConfigOptions TMState'
Lens' TMState' TMConfig
lensTMStateConfig ((TMConfig -> Const ConfigOptions TMConfig)
-> TMState' -> Const ConfigOptions TMState')
-> ((ConfigOptions -> Const ConfigOptions ConfigOptions)
-> TMConfig -> Const ConfigOptions TMConfig)
-> Getting ConfigOptions TMState' ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfigOptions -> Const ConfigOptions ConfigOptions)
-> TMConfig -> Const ConfigOptions TMConfig
Lens' TMConfig ConfigOptions
lensOptions
Terminal -> Maybe FontDescription -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe FontDescription -> m ()
terminalSetFont Terminal
term (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
fontDesc)
Terminal -> CursorBlinkMode -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> CursorBlinkMode -> m ()
terminalSetCursorBlinkMode Terminal
term (ConfigOptions -> CursorBlinkMode
cursorBlinkMode ConfigOptions
options)
Terminal -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Text -> m ()
terminalSetWordCharExceptions Terminal
term (ConfigOptions -> Text
wordCharExceptions ConfigOptions
options)
Terminal -> CLong -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> CLong -> m ()
terminalSetScrollbackLines Terminal
term (Integer -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConfigOptions -> Integer
scrollbackLen ConfigOptions
options))
Terminal -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Bool -> m ()
terminalSetBoldIsBright Terminal
term (ConfigOptions -> Bool
boldIsBright ConfigOptions
options)
Terminal -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Bool -> m ()
terminalSetEnableSixelIfExists Terminal
term (ConfigOptions -> Bool
enableSixel ConfigOptions
options)
Terminal -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Bool -> m ()
terminalSetAllowBold Terminal
term (ConfigOptions -> Bool
allowBold ConfigOptions
options)
let vScrollbarPolicy :: PolicyType
vScrollbarPolicy = ShowScrollbar -> PolicyType
showScrollbarToPolicy (ConfigOptions
options ConfigOptions
-> Getting ShowScrollbar ConfigOptions ShowScrollbar
-> ShowScrollbar
forall s a. s -> Getting a s a -> a
^. Getting ShowScrollbar ConfigOptions ShowScrollbar
Lens' ConfigOptions ShowScrollbar
lensShowScrollbar)
ScrolledWindow -> PolicyType -> PolicyType -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScrolledWindow a) =>
a -> PolicyType -> PolicyType -> m ()
scrolledWindowSetPolicy ScrolledWindow
scrolledWin PolicyType
PolicyTypeAutomatic PolicyType
vScrollbarPolicy
applyNewPreferencesToWindow :: TMState -> TMWindowId -> IO ()
applyNewPreferencesToWindow :: TMState -> TMWindowId -> IO ()
applyNewPreferencesToWindow TMState
mvarTMState TMWindowId
tmWinId = do
TMState'
tmState <- TMState -> IO TMState'
forall a. MVar a -> IO a
readMVar TMState
mvarTMState
TMWindow
tmWin <- TMState' -> TMWindowId -> IO TMWindow
getTMWindowFromTMState' TMState'
tmState TMWindowId
tmWinId
let appWin :: ApplicationWindow
appWin = TMWindow -> ApplicationWindow
tmWindowAppWin TMWindow
tmWin
config :: TMConfig
config = TMState'
tmState TMState' -> Getting TMConfig TMState' TMConfig -> TMConfig
forall s a. s -> Getting a s a -> a
^. Getting TMConfig TMState' TMConfig
Lens' TMState' TMConfig
lensTMStateConfig
notebook :: TMNotebook
notebook = TMWindow -> TMNotebook
tmWindowNotebook TMWindow
tmWin
tabFocusList :: FocusList TMNotebookTab
tabFocusList = TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs TMNotebook
notebook
showMenu :: Bool
showMenu = TMConfig
config TMConfig -> Getting Bool TMConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ConfigOptions -> Const Bool ConfigOptions)
-> TMConfig -> Const Bool TMConfig
Lens' TMConfig ConfigOptions
lensOptions ((ConfigOptions -> Const Bool ConfigOptions)
-> TMConfig -> Const Bool TMConfig)
-> ((Bool -> Const Bool Bool)
-> ConfigOptions -> Const Bool ConfigOptions)
-> Getting Bool TMConfig Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> ConfigOptions -> Const Bool ConfigOptions
Lens' ConfigOptions Bool
lensShowMenu
ApplicationWindow -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationWindow a) =>
a -> Bool -> m ()
applicationWindowSetShowMenubar ApplicationWindow
appWin Bool
showMenu
TMConfig -> Notebook -> IO ()
setShowTabs TMConfig
config (TMNotebook -> Notebook
tmNotebook TMNotebook
notebook)
(TMNotebookTab -> IO ()) -> FocusList TMNotebookTab -> IO ()
forall m a. Monoid m => (a -> m) -> FocusList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TMState -> TMNotebookTab -> IO ()
applyNewPreferencesToTab TMState
mvarTMState) FocusList TMNotebookTab
tabFocusList
applyNewPreferences :: TMState -> IO ()
applyNewPreferences :: TMState -> IO ()
applyNewPreferences TMState
mvarTMState = do
TMState'
tmState <- TMState -> IO TMState'
forall a. MVar a -> IO a
readMVar TMState
mvarTMState
let windows :: IdMap TMWindow
windows = TMState' -> IdMap TMWindow
tmStateWindows TMState'
tmState
(TMWindowId -> IO ()) -> [TMWindowId] -> IO ()
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TMState -> TMWindowId -> IO ()
applyNewPreferencesToWindow TMState
mvarTMState) (IdMap TMWindow -> [TMWindowId]
forall a. IdMap a -> [TMWindowId]
keysIdMap IdMap TMWindow
windows)
showPreferencesDialog :: TMState -> IO ()
showPreferencesDialog :: TMState -> IO ()
showPreferencesDialog TMState
mvarTMState = do
TMState'
tmState <- TMState -> IO TMState'
forall a. MVar a -> IO a
readMVar TMState
mvarTMState
let app :: Application
app = TMState'
tmState TMState' -> Getting Application TMState' Application -> Application
forall s a. s -> Getting a s a -> a
^. Getting Application TMState' Application
Lens' TMState' Application
lensTMStateApp
Builder
preferencesBuilder <-
Text -> Int64 -> IO Builder
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int64 -> m Builder
builderNewFromString Text
preferencesText (Int64 -> IO Builder) -> Int64 -> IO Builder
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
Text.length Text
preferencesText)
Dialog
preferencesDialog <-
Builder -> Text -> (ManagedPtr Dialog -> Dialog) -> IO Dialog
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"preferences" ManagedPtr Dialog -> Dialog
Dialog
CheckButton
confirmExitCheckButton <-
Builder
-> Text
-> (ManagedPtr CheckButton -> CheckButton)
-> IO CheckButton
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"confirmExit" ManagedPtr CheckButton -> CheckButton
CheckButton
CheckButton
showMenuCheckButton <-
Builder
-> Text
-> (ManagedPtr CheckButton -> CheckButton)
-> IO CheckButton
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"showMenu" ManagedPtr CheckButton -> CheckButton
CheckButton
CheckButton
boldIsBrightCheckButton <-
Builder
-> Text
-> (ManagedPtr CheckButton -> CheckButton)
-> IO CheckButton
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"boldIsBright" ManagedPtr CheckButton -> CheckButton
CheckButton
CheckButton
enableSixelCheckButton <-
Builder
-> Text
-> (ManagedPtr CheckButton -> CheckButton)
-> IO CheckButton
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"enableSixel" ManagedPtr CheckButton -> CheckButton
CheckButton
CheckButton
allowBoldCheckButton <-
Builder
-> Text
-> (ManagedPtr CheckButton -> CheckButton)
-> IO CheckButton
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"allowBold" ManagedPtr CheckButton -> CheckButton
CheckButton
EntryBuffer
wordCharExceptionsEntryBuffer <-
Builder -> Text -> (ManagedPtr Entry -> Entry) -> IO Entry
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"wordCharExceptions" ManagedPtr Entry -> Entry
Entry IO Entry -> (Entry -> IO EntryBuffer) -> IO EntryBuffer
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Entry -> IO EntryBuffer
forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m EntryBuffer
getEntryBuffer
FontButton
fontButton <- Builder
-> Text -> (ManagedPtr FontButton -> FontButton) -> IO FontButton
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"font" ManagedPtr FontButton -> FontButton
FontButton
ComboBoxText
showScrollbarComboBoxText <-
Builder
-> Text
-> (ManagedPtr ComboBoxText -> ComboBoxText)
-> IO ComboBoxText
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"showScrollbar" ManagedPtr ComboBoxText -> ComboBoxText
ComboBoxText
ComboBoxText -> [(ShowScrollbar, Text)] -> IO ()
forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
comboBoxFill
ComboBoxText
showScrollbarComboBoxText
[ (ShowScrollbar
ShowScrollbarNever, Text
"Never")
, (ShowScrollbar
ShowScrollbarAlways, Text
"Always")
, (ShowScrollbar
ShowScrollbarIfNeeded, Text
"If needed")
]
ComboBoxText
showTabBarComboBoxText <-
Builder
-> Text
-> (ManagedPtr ComboBoxText -> ComboBoxText)
-> IO ComboBoxText
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"showTabBar" ManagedPtr ComboBoxText -> ComboBoxText
ComboBoxText
ComboBoxText -> [(ShowTabBar, Text)] -> IO ()
forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
comboBoxFill
ComboBoxText
showTabBarComboBoxText
[ (ShowTabBar
ShowTabBarNever, Text
"Never")
, (ShowTabBar
ShowTabBarAlways, Text
"Always")
, (ShowTabBar
ShowTabBarIfNeeded, Text
"If needed")
]
ComboBoxText
cursorBlinkModeComboBoxText <-
Builder
-> Text
-> (ManagedPtr ComboBoxText -> ComboBoxText)
-> IO ComboBoxText
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"cursorBlinkMode" ManagedPtr ComboBoxText -> ComboBoxText
ComboBoxText
ComboBoxText -> [(CursorBlinkMode, Text)] -> IO ()
forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
comboBoxFill
ComboBoxText
cursorBlinkModeComboBoxText
[ (CursorBlinkMode
CursorBlinkModeSystem, Text
"System")
, (CursorBlinkMode
CursorBlinkModeOn, Text
"On")
, (CursorBlinkMode
CursorBlinkModeOff, Text
"Off")
]
SpinButton
scrollbackLenSpinButton <-
Builder
-> Text -> (ManagedPtr SpinButton -> SpinButton) -> IO SpinButton
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"scrollbackLen" ManagedPtr SpinButton -> SpinButton
SpinButton
Double
-> Double -> Double -> Double -> Double -> Double -> IO Adjustment
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Double
-> Double -> Double -> Double -> Double -> Double -> m Adjustment
adjustmentNew Double
0 Double
0 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)) Double
1 Double
10 Double
0 IO Adjustment -> (Adjustment -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
SpinButton -> Adjustment -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSpinButton a, IsAdjustment b) =>
a -> b -> m ()
spinButtonSetAdjustment SpinButton
scrollbackLenSpinButton
Label
warningLabel <- Builder -> Text -> (ManagedPtr Label -> Label) -> IO Label
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"warning" ManagedPtr Label -> Label
Label
FilePath
executablePath <- IO FilePath
getExecutablePath
let hasTermonadHs :: Bool
hasTermonadHs = FilePath -> FilePath
takeFileName FilePath
executablePath FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"termonad-linux-x86_64"
Label -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Bool -> m ()
widgetSetVisible Label
warningLabel Bool
hasTermonadHs
Maybe Window
maybeWin <- Application -> IO (Maybe Window)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> m (Maybe Window)
applicationGetActiveWindow Application
app
Dialog -> Maybe Window -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWindow a, IsWindow b) =>
a -> Maybe b -> m ()
windowSetTransientFor Dialog
preferencesDialog Maybe Window
maybeWin
FontButton -> FontDescription -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontChooser a) =>
a -> FontDescription -> m ()
fontChooserSetFontDesc FontButton
fontButton (TMState'
tmState TMState'
-> Getting FontDescription TMState' FontDescription
-> FontDescription
forall s a. s -> Getting a s a -> a
^. Getting FontDescription TMState' FontDescription
Lens' TMState' FontDescription
lensTMStateFontDesc)
let options :: ConfigOptions
options = TMState'
tmState TMState'
-> Getting ConfigOptions TMState' ConfigOptions -> ConfigOptions
forall s a. s -> Getting a s a -> a
^. (TMConfig -> Const ConfigOptions TMConfig)
-> TMState' -> Const ConfigOptions TMState'
Lens' TMState' TMConfig
lensTMStateConfig ((TMConfig -> Const ConfigOptions TMConfig)
-> TMState' -> Const ConfigOptions TMState')
-> ((ConfigOptions -> Const ConfigOptions ConfigOptions)
-> TMConfig -> Const ConfigOptions TMConfig)
-> Getting ConfigOptions TMState' ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfigOptions -> Const ConfigOptions ConfigOptions)
-> TMConfig -> Const ConfigOptions TMConfig
Lens' TMConfig ConfigOptions
lensOptions
ComboBoxText -> ShowScrollbar -> IO ()
forall a. Show a => ComboBoxText -> a -> IO ()
comboBoxSetActive ComboBoxText
showScrollbarComboBoxText (ShowScrollbar -> IO ()) -> ShowScrollbar -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> ShowScrollbar
showScrollbar ConfigOptions
options
ComboBoxText -> ShowTabBar -> IO ()
forall a. Show a => ComboBoxText -> a -> IO ()
comboBoxSetActive ComboBoxText
showTabBarComboBoxText (ShowTabBar -> IO ()) -> ShowTabBar -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> ShowTabBar
showTabBar ConfigOptions
options
ComboBoxText -> CursorBlinkMode -> IO ()
forall a. Show a => ComboBoxText -> a -> IO ()
comboBoxSetActive ComboBoxText
cursorBlinkModeComboBoxText (CursorBlinkMode -> IO ()) -> CursorBlinkMode -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> CursorBlinkMode
cursorBlinkMode ConfigOptions
options
SpinButton -> Double -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpinButton a) =>
a -> Double -> m ()
spinButtonSetValue SpinButton
scrollbackLenSpinButton (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Integer
scrollbackLen ConfigOptions
options)
CheckButton -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> Bool -> m ()
toggleButtonSetActive CheckButton
confirmExitCheckButton (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Bool
confirmExit ConfigOptions
options
CheckButton -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> Bool -> m ()
toggleButtonSetActive CheckButton
showMenuCheckButton (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Bool
showMenu ConfigOptions
options
CheckButton -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> Bool -> m ()
toggleButtonSetActive CheckButton
boldIsBrightCheckButton (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Bool
boldIsBright ConfigOptions
options
CheckButton -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> Bool -> m ()
toggleButtonSetActive CheckButton
enableSixelCheckButton (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Bool
enableSixel ConfigOptions
options
CheckButton -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> Bool -> m ()
toggleButtonSetActive CheckButton
allowBoldCheckButton (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Bool
allowBold ConfigOptions
options
EntryBuffer -> Text -> Int32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntryBuffer a) =>
a -> Text -> Int32 -> m ()
entryBufferSetText EntryBuffer
wordCharExceptionsEntryBuffer (ConfigOptions -> Text
wordCharExceptions ConfigOptions
options) (-Int32
1)
Int32
res <- Dialog -> IO Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> m Int32
dialogRun Dialog
preferencesDialog
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> ResponseType
forall a. Enum a => Int -> a
toEnum (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
res) ResponseType -> ResponseType -> Bool
forall a. Eq a => a -> a -> Bool
== ResponseType
ResponseTypeAccept) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Maybe FontDescription
maybeFontDesc <- FontButton -> IO (Maybe FontDescription)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontChooser a) =>
a -> m (Maybe FontDescription)
fontChooserGetFontDesc FontButton
fontButton
Maybe FontConfig
maybeFontConfig <-
Maybe (Maybe FontConfig) -> Maybe FontConfig
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe FontConfig) -> Maybe FontConfig)
-> IO (Maybe (Maybe FontConfig)) -> IO (Maybe FontConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FontDescription -> IO (Maybe FontConfig))
-> Maybe FontDescription -> IO (Maybe (Maybe FontConfig))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM FontDescription -> IO (Maybe FontConfig)
fontConfigFromFontDescription Maybe FontDescription
maybeFontDesc
Maybe ShowScrollbar
maybeShowScrollbar <-
ComboBoxText -> [ShowScrollbar] -> IO (Maybe ShowScrollbar)
forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
comboBoxGetActive ComboBoxText
showScrollbarComboBoxText [Item [ShowScrollbar]
ShowScrollbar
ShowScrollbarNever ..]
Maybe ShowTabBar
maybeShowTabBar <-
ComboBoxText -> [ShowTabBar] -> IO (Maybe ShowTabBar)
forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
comboBoxGetActive ComboBoxText
showTabBarComboBoxText [Item [ShowTabBar]
ShowTabBar
ShowTabBarNever ..]
Maybe CursorBlinkMode
maybeCursorBlinkMode <-
ComboBoxText -> [CursorBlinkMode] -> IO (Maybe CursorBlinkMode)
forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
comboBoxGetActive ComboBoxText
cursorBlinkModeComboBoxText [Item [CursorBlinkMode]
CursorBlinkMode
CursorBlinkModeSystem ..]
Integer
scrollbackLenVal <-
Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Integer) -> IO Int32 -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpinButton -> IO Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpinButton a) =>
a -> m Int32
spinButtonGetValueAsInt SpinButton
scrollbackLenSpinButton
Bool
confirmExitVal <- CheckButton -> IO Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> m Bool
toggleButtonGetActive CheckButton
confirmExitCheckButton
Bool
showMenuVal <- CheckButton -> IO Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> m Bool
toggleButtonGetActive CheckButton
showMenuCheckButton
Bool
boldIsBrightVal <- CheckButton -> IO Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> m Bool
toggleButtonGetActive CheckButton
boldIsBrightCheckButton
Bool
enableSixelVal <- CheckButton -> IO Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> m Bool
toggleButtonGetActive CheckButton
enableSixelCheckButton
Bool
allowBoldVal <- CheckButton -> IO Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> m Bool
toggleButtonGetActive CheckButton
allowBoldCheckButton
Text
wordCharExceptionsVal <- EntryBuffer -> IO Text
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntryBuffer a) =>
a -> m Text
entryBufferGetText EntryBuffer
wordCharExceptionsEntryBuffer
TMState -> (TMState' -> IO TMState') -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ TMState
mvarTMState ((TMState' -> IO TMState') -> IO ())
-> (TMState' -> IO TMState') -> IO ()
forall a b. (a -> b) -> a -> b
$ TMState' -> IO TMState'
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(TMState' -> IO TMState')
-> (TMState' -> TMState') -> TMState' -> IO TMState'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter TMState' TMState' FontDescription FontDescription
-> (FontDescription -> FontDescription) -> TMState' -> TMState'
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter TMState' TMState' FontDescription FontDescription
Lens' TMState' FontDescription
lensTMStateFontDesc (FontDescription -> Maybe FontDescription -> FontDescription
forall a. a -> Maybe a -> a
`fromMaybe` Maybe FontDescription
maybeFontDesc)
(TMState' -> TMState')
-> (TMState' -> TMState') -> TMState' -> TMState'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter TMState' TMState' ConfigOptions ConfigOptions
-> (ConfigOptions -> ConfigOptions) -> TMState' -> TMState'
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((TMConfig -> Identity TMConfig) -> TMState' -> Identity TMState'
Lens' TMState' TMConfig
lensTMStateConfig ((TMConfig -> Identity TMConfig) -> TMState' -> Identity TMState')
-> ((ConfigOptions -> Identity ConfigOptions)
-> TMConfig -> Identity TMConfig)
-> ASetter TMState' TMState' ConfigOptions ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfigOptions -> Identity ConfigOptions)
-> TMConfig -> Identity TMConfig
Lens' TMConfig ConfigOptions
lensOptions)
( ASetter ConfigOptions ConfigOptions Bool Bool
-> Bool -> ConfigOptions -> ConfigOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ConfigOptions ConfigOptions Bool Bool
Lens' ConfigOptions Bool
lensConfirmExit Bool
confirmExitVal
(ConfigOptions -> ConfigOptions)
-> (ConfigOptions -> ConfigOptions)
-> ConfigOptions
-> ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ConfigOptions ConfigOptions Bool Bool
-> Bool -> ConfigOptions -> ConfigOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ConfigOptions ConfigOptions Bool Bool
Lens' ConfigOptions Bool
lensShowMenu Bool
showMenuVal
(ConfigOptions -> ConfigOptions)
-> (ConfigOptions -> ConfigOptions)
-> ConfigOptions
-> ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ConfigOptions ConfigOptions Bool Bool
-> Bool -> ConfigOptions -> ConfigOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ConfigOptions ConfigOptions Bool Bool
Lens' ConfigOptions Bool
lensBoldIsBright Bool
boldIsBrightVal
(ConfigOptions -> ConfigOptions)
-> (ConfigOptions -> ConfigOptions)
-> ConfigOptions
-> ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ConfigOptions ConfigOptions Bool Bool
-> Bool -> ConfigOptions -> ConfigOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ConfigOptions ConfigOptions Bool Bool
Lens' ConfigOptions Bool
lensEnableSixel Bool
enableSixelVal
(ConfigOptions -> ConfigOptions)
-> (ConfigOptions -> ConfigOptions)
-> ConfigOptions
-> ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ConfigOptions ConfigOptions Bool Bool
-> Bool -> ConfigOptions -> ConfigOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ConfigOptions ConfigOptions Bool Bool
Lens' ConfigOptions Bool
lensAllowBold Bool
allowBoldVal
(ConfigOptions -> ConfigOptions)
-> (ConfigOptions -> ConfigOptions)
-> ConfigOptions
-> ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ConfigOptions ConfigOptions Text Text
-> Text -> ConfigOptions -> ConfigOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ConfigOptions ConfigOptions Text Text
Lens' ConfigOptions Text
lensWordCharExceptions Text
wordCharExceptionsVal
(ConfigOptions -> ConfigOptions)
-> (ConfigOptions -> ConfigOptions)
-> ConfigOptions
-> ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ConfigOptions ConfigOptions FontConfig FontConfig
-> (FontConfig -> FontConfig) -> ConfigOptions -> ConfigOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ConfigOptions ConfigOptions FontConfig FontConfig
Lens' ConfigOptions FontConfig
lensFontConfig (FontConfig -> Maybe FontConfig -> FontConfig
forall a. a -> Maybe a -> a
`fromMaybe` Maybe FontConfig
maybeFontConfig)
(ConfigOptions -> ConfigOptions)
-> (ConfigOptions -> ConfigOptions)
-> ConfigOptions
-> ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ConfigOptions ConfigOptions Integer Integer
-> Integer -> ConfigOptions -> ConfigOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ConfigOptions ConfigOptions Integer Integer
Lens' ConfigOptions Integer
lensScrollbackLen Integer
scrollbackLenVal
(ConfigOptions -> ConfigOptions)
-> (ConfigOptions -> ConfigOptions)
-> ConfigOptions
-> ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ConfigOptions ConfigOptions ShowScrollbar ShowScrollbar
-> (ShowScrollbar -> ShowScrollbar)
-> ConfigOptions
-> ConfigOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ConfigOptions ConfigOptions ShowScrollbar ShowScrollbar
Lens' ConfigOptions ShowScrollbar
lensShowScrollbar (ShowScrollbar -> Maybe ShowScrollbar -> ShowScrollbar
forall a. a -> Maybe a -> a
`fromMaybe` Maybe ShowScrollbar
maybeShowScrollbar)
(ConfigOptions -> ConfigOptions)
-> (ConfigOptions -> ConfigOptions)
-> ConfigOptions
-> ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ConfigOptions ConfigOptions ShowTabBar ShowTabBar
-> (ShowTabBar -> ShowTabBar) -> ConfigOptions -> ConfigOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ConfigOptions ConfigOptions ShowTabBar ShowTabBar
Lens' ConfigOptions ShowTabBar
lensShowTabBar (ShowTabBar -> Maybe ShowTabBar -> ShowTabBar
forall a. a -> Maybe a -> a
`fromMaybe` Maybe ShowTabBar
maybeShowTabBar)
(ConfigOptions -> ConfigOptions)
-> (ConfigOptions -> ConfigOptions)
-> ConfigOptions
-> ConfigOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ConfigOptions ConfigOptions CursorBlinkMode CursorBlinkMode
-> (CursorBlinkMode -> CursorBlinkMode)
-> ConfigOptions
-> ConfigOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ConfigOptions ConfigOptions CursorBlinkMode CursorBlinkMode
Lens' ConfigOptions CursorBlinkMode
lensCursorBlinkMode (CursorBlinkMode -> Maybe CursorBlinkMode -> CursorBlinkMode
forall a. a -> Maybe a -> a
`fromMaybe` Maybe CursorBlinkMode
maybeCursorBlinkMode)
)
TMState -> (TMState' -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar TMState
mvarTMState ((TMState' -> IO ()) -> IO ()) -> (TMState' -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ TMConfig -> IO ()
saveToPreferencesFile (TMConfig -> IO ()) -> (TMState' -> TMConfig) -> TMState' -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting TMConfig TMState' TMConfig -> TMState' -> TMConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TMConfig TMState' TMConfig
Lens' TMState' TMConfig
lensTMStateConfig
TMState -> IO ()
applyNewPreferences TMState
mvarTMState
Dialog -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetDestroy Dialog
preferencesDialog