{-# LANGUAGE CPP #-}

-- | Description : Controls the Preferences dialog and setting app preferences
-- Copyright     : (c) Dennis Gosnell, 2023
-- License       : BSD3
-- Stability     : experimental
-- Portability   : POSIX
--
-- This module controls the Preferences dialog, which lets you set Termonad
-- preferences at run-time.
--
-- It also exports helpful functions from "Termonad.Preferences.File".

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)

-- | Fill a combo box with ids and labels
--
-- The ids are stored in the combobox as 'Text', so their type should be an
-- instance of the 'Show' type class.
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

-- | Set the current active item in a combobox given an input id.
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)

-- | Get the current active item in a combobox
--
-- The list of values to be searched in the combobox must be given as a
-- parameter. These values are converted to Text then compared to the current
-- id.
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)
  -- Sets the remaining preferences to each tab
  (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

-- | Takes a 'TMState', and looks at the 'TMConfig' within.
-- Take all the configuration options from the 'TMConfig' and apply them to the
-- current 'Application', 'Window's, and 'Term's.
--
-- This function is meant to be used after a big update to the 'TMConfig' within a
-- 'TMState'.
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)

-- | Show the preferences dialog.
--
-- When the user clicks on the Ok button, it copies the new settings to TMState.
-- Then apply them to the current terminals.
showPreferencesDialog :: TMState -> IO ()
showPreferencesDialog :: TMState -> IO ()
showPreferencesDialog TMState
mvarTMState = do
  -- Get app out of mvar
  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

  -- Create the preference dialog and get some widgets
  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

  -- We show the warning label only if the user has launched termonad with a
  -- termonad.hs file
  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

  -- Make the dialog modal
  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

  -- Init with current state
  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)

  -- Run dialog then close
  Int32
res <- Dialog -> IO Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> m Int32
dialogRun Dialog
preferencesDialog

  -- When closing the dialog get the new settings
  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

    -- Apply the changes to mvarTMState
    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)
        )

    -- Save the changes to the preferences files
    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

    -- Update the app with new settings
    TMState -> IO ()
applyNewPreferences TMState
mvarTMState

  Dialog -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetDestroy Dialog
preferencesDialog