From 25fd05b1483595e91ae3ad3ef1ef7cc3d8153050 Mon Sep 17 00:00:00 2001 From: "(cdep)illabout" Date: Sun, 22 Oct 2023 09:15:08 +0900 Subject: [PATCH] wip --- src/Termonad/App.hs | 199 ---------------------------------- src/Termonad/Preferences.hs | 209 ++++++++++++++++++++++++++++++++++++ 2 files changed, 209 insertions(+), 199 deletions(-) diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs index cafface..3c76c04 100644 --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -701,205 +701,6 @@ setShowMenuBar app visible = do appWin <- MaybeT $ castTo ApplicationWindow win lift $ applicationWindowSetShowMenubar appWin visible --- | 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 comboBox = mapM_ go - where - go :: (a, Text) -> IO () - go (value, textId) = - comboBoxTextAppend comboBox (Just $ tshow value) textId - --- | Set the current active item in a combobox given an input id. -comboBoxSetActive :: Show a => ComboBoxText -> a -> IO () -comboBoxSetActive cb item = void $ comboBoxSetActiveId cb (Just $ tshow 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 cb values = findEnumFromMaybeId <$> comboBoxGetActiveId cb - where - findEnumFromMaybeId :: Maybe Text -> Maybe a - findEnumFromMaybeId maybeId = maybeId >>= findEnumFromId - - findEnumFromId :: Text -> Maybe a - findEnumFromId label = List.find (\x -> tshow x == label) values - -applyNewPreferencesToTab :: TMState -> TMNotebookTab -> IO () -applyNewPreferencesToTab mvarTMState tab = do - tmState <- readMVar mvarTMState - let fontDesc = tmState ^. lensTMStateFontDesc - term = tab ^. lensTMNotebookTabTerm . lensTerm - scrolledWin = tab ^. lensTMNotebookTabTermContainer - options = tmState ^. lensTMStateConfig . lensOptions - terminalSetFont term (Just fontDesc) - terminalSetCursorBlinkMode term (cursorBlinkMode options) - terminalSetWordCharExceptions term (wordCharExceptions options) - terminalSetScrollbackLines term (fromIntegral (scrollbackLen options)) - terminalSetBoldIsBright term (boldIsBright options) - terminalSetEnableSixelIfExists term (enableSixel options) - terminalSetAllowBold term (allowBold options) - - let vScrollbarPolicy = showScrollbarToPolicy (options ^. lensShowScrollbar) - scrolledWindowSetPolicy scrolledWin PolicyTypeAutomatic vScrollbarPolicy - -applyNewPreferencesToWindow :: TMState -> TMWindowId -> IO () -applyNewPreferencesToWindow mvarTMState tmWinId = do - tmState <- readMVar mvarTMState - tmWin <- getTMWindowFromTMState' tmState tmWinId - let appWin = tmWindowAppWin tmWin - config = tmState ^. lensTMStateConfig - notebook = tmWindowNotebook tmWin - tabFocusList = tmNotebookTabs notebook - showMenu = config ^. lensOptions . lensShowMenu - applicationWindowSetShowMenubar appWin showMenu - setShowTabs config (tmNotebook notebook) - -- Sets the remaining preferences to each tab - foldMap (applyNewPreferencesToTab mvarTMState) tabFocusList - -applyNewPreferences :: TMState -> IO () -applyNewPreferences mvarTMState = do - tmState <- readMVar mvarTMState - let windows = tmStateWindows tmState - foldMap (applyNewPreferencesToWindow mvarTMState) (keysIdMap 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 mvarTMState = do - -- Get app out of mvar - tmState <- readMVar mvarTMState - let app = tmState ^. lensTMStateApp - - -- Create the preference dialog and get some widgets - preferencesBuilder <- - builderNewFromString preferencesText $ fromIntegral (Text.length preferencesText) - preferencesDialog <- - objFromBuildUnsafe preferencesBuilder "preferences" Dialog - confirmExitCheckButton <- - objFromBuildUnsafe preferencesBuilder "confirmExit" CheckButton - showMenuCheckButton <- - objFromBuildUnsafe preferencesBuilder "showMenu" CheckButton - boldIsBrightCheckButton <- - objFromBuildUnsafe preferencesBuilder "boldIsBright" CheckButton - enableSixelCheckButton <- - objFromBuildUnsafe preferencesBuilder "enableSixel" CheckButton - allowBoldCheckButton <- - objFromBuildUnsafe preferencesBuilder "allowBold" CheckButton - wordCharExceptionsEntryBuffer <- - objFromBuildUnsafe preferencesBuilder "wordCharExceptions" Entry >>= - getEntryBuffer - fontButton <- objFromBuildUnsafe preferencesBuilder "font" FontButton - showScrollbarComboBoxText <- - objFromBuildUnsafe preferencesBuilder "showScrollbar" ComboBoxText - comboBoxFill - showScrollbarComboBoxText - [ (ShowScrollbarNever, "Never") - , (ShowScrollbarAlways, "Always") - , (ShowScrollbarIfNeeded, "If needed") - ] - showTabBarComboBoxText <- - objFromBuildUnsafe preferencesBuilder "showTabBar" ComboBoxText - comboBoxFill - showTabBarComboBoxText - [ (ShowTabBarNever, "Never") - , (ShowTabBarAlways, "Always") - , (ShowTabBarIfNeeded, "If needed") - ] - cursorBlinkModeComboBoxText <- - objFromBuildUnsafe preferencesBuilder "cursorBlinkMode" ComboBoxText - comboBoxFill - cursorBlinkModeComboBoxText - [ (CursorBlinkModeSystem, "System") - , (CursorBlinkModeOn, "On") - , (CursorBlinkModeOff, "Off") - ] - scrollbackLenSpinButton <- - objFromBuildUnsafe preferencesBuilder "scrollbackLen" SpinButton - adjustmentNew 0 0 (fromIntegral (maxBound :: Int)) 1 10 0 >>= - spinButtonSetAdjustment scrollbackLenSpinButton - warningLabel <- objFromBuildUnsafe preferencesBuilder "warning" Label - - -- We show the warning label only if the user has launched termonad with a - -- termonad.hs file - executablePath <- getExecutablePath - let hasTermonadHs = takeFileName executablePath == "termonad-linux-x86_64" - widgetSetVisible warningLabel hasTermonadHs - - -- Make the dialog modal - maybeWin <- applicationGetActiveWindow app - windowSetTransientFor preferencesDialog maybeWin - - -- Init with current state - fontChooserSetFontDesc fontButton (tmState ^. lensTMStateFontDesc) - let options = tmState ^. lensTMStateConfig . lensOptions - comboBoxSetActive showScrollbarComboBoxText $ showScrollbar options - comboBoxSetActive showTabBarComboBoxText $ showTabBar options - comboBoxSetActive cursorBlinkModeComboBoxText $ cursorBlinkMode options - spinButtonSetValue scrollbackLenSpinButton (fromIntegral $ scrollbackLen options) - toggleButtonSetActive confirmExitCheckButton $ confirmExit options - toggleButtonSetActive showMenuCheckButton $ showMenu options - toggleButtonSetActive boldIsBrightCheckButton $ boldIsBright options - toggleButtonSetActive enableSixelCheckButton $ enableSixel options - toggleButtonSetActive allowBoldCheckButton $ allowBold options - entryBufferSetText wordCharExceptionsEntryBuffer (wordCharExceptions options) (-1) - - -- Run dialog then close - res <- dialogRun preferencesDialog - - -- When closing the dialog get the new settings - when (toEnum (fromIntegral res) == ResponseTypeAccept) $ do - maybeFontDesc <- fontChooserGetFontDesc fontButton - maybeFontConfig <- - join <$> mapM fontConfigFromFontDescription maybeFontDesc - maybeShowScrollbar <- - comboBoxGetActive showScrollbarComboBoxText [ShowScrollbarNever ..] - maybeShowTabBar <- - comboBoxGetActive showTabBarComboBoxText [ShowTabBarNever ..] - maybeCursorBlinkMode <- - comboBoxGetActive cursorBlinkModeComboBoxText [CursorBlinkModeSystem ..] - scrollbackLenVal <- - fromIntegral <$> spinButtonGetValueAsInt scrollbackLenSpinButton - confirmExitVal <- toggleButtonGetActive confirmExitCheckButton - showMenuVal <- toggleButtonGetActive showMenuCheckButton - boldIsBrightVal <- toggleButtonGetActive boldIsBrightCheckButton - enableSixelVal <- toggleButtonGetActive enableSixelCheckButton - allowBoldVal <- toggleButtonGetActive allowBoldCheckButton - wordCharExceptionsVal <- entryBufferGetText wordCharExceptionsEntryBuffer - - -- Apply the changes to mvarTMState - modifyMVar_ mvarTMState $ pure - . over lensTMStateFontDesc (`fromMaybe` maybeFontDesc) - . over (lensTMStateConfig . lensOptions) - ( set lensConfirmExit confirmExitVal - . set lensShowMenu showMenuVal - . set lensBoldIsBright boldIsBrightVal - . set lensEnableSixel enableSixelVal - . set lensAllowBold allowBoldVal - . set lensWordCharExceptions wordCharExceptionsVal - . over lensFontConfig (`fromMaybe` maybeFontConfig) - . set lensScrollbackLen scrollbackLenVal - . over lensShowScrollbar (`fromMaybe` maybeShowScrollbar) - . over lensShowTabBar (`fromMaybe` maybeShowTabBar) - . over lensCursorBlinkMode (`fromMaybe` maybeCursorBlinkMode) - ) - - -- Save the changes to the preferences files - withMVar mvarTMState $ saveToPreferencesFile . view lensTMStateConfig - - -- Update the app with new settings - applyNewPreferences mvarTMState - - widgetDestroy preferencesDialog - appStartup :: Application -> IO () appStartup _app = pure () diff --git a/src/Termonad/Preferences.hs b/src/Termonad/Preferences.hs index bf63397..8dbe51c 100644 --- a/src/Termonad/Preferences.hs +++ b/src/Termonad/Preferences.hs @@ -7,3 +7,212 @@ module Termonad.Preferences import Termonad.Prelude import Termonad.Preferences.File (saveToPreferencesFile, tmConfigFromPreferencesFile) +import GI.Gtk (ComboBoxText(ComboBoxText), comboBoxSetActiveId, comboBoxGetActiveId, comboBoxTextAppend) +import qualified Data.List as List +import Termonad.Types (TMState, TMNotebookTab, TMWindowId, cursorBlinkMode, wordCharExceptions, scrollbackLen, boldIsBright, ConfigOptions (enableSixel, allowBold)) +import qualified Data.Text as Text +import Control.Lens ((^.)) +import Termonad.Lenses (lensTMStateFontDesc, lensTMNotebookTabTerm, lensTerm, lensTMNotebookTabTermContainer, lensTMStateConfig, lensOptions, lensShowScrollbar) +import GI.Vte (terminalSetFont, terminalSetCursorBlinkMode, terminalSetWordCharExceptions, terminalSetScrollbackLines, terminalSetBoldIsBright, terminalSetAllowBold) +import Termonad.Gtk (terminalSetEnableSixelIfExists) +import Termonad.Term (showScrollbarToPolicy) + +-- | 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 comboBox = mapM_ go + where + go :: (a, Text) -> IO () + go (value, textId) = + comboBoxTextAppend comboBox (Just $ tshow value) textId + +-- | Set the current active item in a combobox given an input id. +comboBoxSetActive :: Show a => ComboBoxText -> a -> IO () +comboBoxSetActive cb item = void $ comboBoxSetActiveId cb (Just $ tshow 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 cb values = findEnumFromMaybeId <$> comboBoxGetActiveId cb + where + findEnumFromMaybeId :: Maybe Text -> Maybe a + findEnumFromMaybeId maybeId = maybeId >>= findEnumFromId + + findEnumFromId :: Text -> Maybe a + findEnumFromId label = List.find (\x -> tshow x == label) values + +applyNewPreferencesToTab :: TMState -> TMNotebookTab -> IO () +applyNewPreferencesToTab mvarTMState tab = do + tmState <- readMVar mvarTMState + let fontDesc = tmState ^. lensTMStateFontDesc + term = tab ^. lensTMNotebookTabTerm . lensTerm + scrolledWin = tab ^. lensTMNotebookTabTermContainer + options = tmState ^. lensTMStateConfig . lensOptions + terminalSetFont term (Just fontDesc) + terminalSetCursorBlinkMode term (cursorBlinkMode options) + terminalSetWordCharExceptions term (wordCharExceptions options) + terminalSetScrollbackLines term (fromIntegral (scrollbackLen options)) + terminalSetBoldIsBright term (boldIsBright options) + terminalSetEnableSixelIfExists term (enableSixel options) + terminalSetAllowBold term (allowBold options) + + let vScrollbarPolicy = showScrollbarToPolicy (options ^. lensShowScrollbar) + scrolledWindowSetPolicy scrolledWin PolicyTypeAutomatic vScrollbarPolicy + +applyNewPreferencesToWindow :: TMState -> TMWindowId -> IO () +applyNewPreferencesToWindow mvarTMState tmWinId = do + tmState <- readMVar mvarTMState + tmWin <- getTMWindowFromTMState' tmState tmWinId + let appWin = tmWindowAppWin tmWin + config = tmState ^. lensTMStateConfig + notebook = tmWindowNotebook tmWin + tabFocusList = tmNotebookTabs notebook + showMenu = config ^. lensOptions . lensShowMenu + applicationWindowSetShowMenubar appWin showMenu + setShowTabs config (tmNotebook notebook) + -- Sets the remaining preferences to each tab + foldMap (applyNewPreferencesToTab mvarTMState) tabFocusList + +applyNewPreferences :: TMState -> IO () +applyNewPreferences mvarTMState = do + tmState <- readMVar mvarTMState + let windows = tmStateWindows tmState + foldMap (applyNewPreferencesToWindow mvarTMState) (keysIdMap 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 mvarTMState = do + -- Get app out of mvar + tmState <- readMVar mvarTMState + let app = tmState ^. lensTMStateApp + + -- Create the preference dialog and get some widgets + preferencesBuilder <- + builderNewFromString preferencesText $ fromIntegral (Text.length preferencesText) + preferencesDialog <- + objFromBuildUnsafe preferencesBuilder "preferences" Dialog + confirmExitCheckButton <- + objFromBuildUnsafe preferencesBuilder "confirmExit" CheckButton + showMenuCheckButton <- + objFromBuildUnsafe preferencesBuilder "showMenu" CheckButton + boldIsBrightCheckButton <- + objFromBuildUnsafe preferencesBuilder "boldIsBright" CheckButton + enableSixelCheckButton <- + objFromBuildUnsafe preferencesBuilder "enableSixel" CheckButton + allowBoldCheckButton <- + objFromBuildUnsafe preferencesBuilder "allowBold" CheckButton + wordCharExceptionsEntryBuffer <- + objFromBuildUnsafe preferencesBuilder "wordCharExceptions" Entry >>= + getEntryBuffer + fontButton <- objFromBuildUnsafe preferencesBuilder "font" FontButton + showScrollbarComboBoxText <- + objFromBuildUnsafe preferencesBuilder "showScrollbar" ComboBoxText + comboBoxFill + showScrollbarComboBoxText + [ (ShowScrollbarNever, "Never") + , (ShowScrollbarAlways, "Always") + , (ShowScrollbarIfNeeded, "If needed") + ] + showTabBarComboBoxText <- + objFromBuildUnsafe preferencesBuilder "showTabBar" ComboBoxText + comboBoxFill + showTabBarComboBoxText + [ (ShowTabBarNever, "Never") + , (ShowTabBarAlways, "Always") + , (ShowTabBarIfNeeded, "If needed") + ] + cursorBlinkModeComboBoxText <- + objFromBuildUnsafe preferencesBuilder "cursorBlinkMode" ComboBoxText + comboBoxFill + cursorBlinkModeComboBoxText + [ (CursorBlinkModeSystem, "System") + , (CursorBlinkModeOn, "On") + , (CursorBlinkModeOff, "Off") + ] + scrollbackLenSpinButton <- + objFromBuildUnsafe preferencesBuilder "scrollbackLen" SpinButton + adjustmentNew 0 0 (fromIntegral (maxBound :: Int)) 1 10 0 >>= + spinButtonSetAdjustment scrollbackLenSpinButton + warningLabel <- objFromBuildUnsafe preferencesBuilder "warning" Label + + -- We show the warning label only if the user has launched termonad with a + -- termonad.hs file + executablePath <- getExecutablePath + let hasTermonadHs = takeFileName executablePath == "termonad-linux-x86_64" + widgetSetVisible warningLabel hasTermonadHs + + -- Make the dialog modal + maybeWin <- applicationGetActiveWindow app + windowSetTransientFor preferencesDialog maybeWin + + -- Init with current state + fontChooserSetFontDesc fontButton (tmState ^. lensTMStateFontDesc) + let options = tmState ^. lensTMStateConfig . lensOptions + comboBoxSetActive showScrollbarComboBoxText $ showScrollbar options + comboBoxSetActive showTabBarComboBoxText $ showTabBar options + comboBoxSetActive cursorBlinkModeComboBoxText $ cursorBlinkMode options + spinButtonSetValue scrollbackLenSpinButton (fromIntegral $ scrollbackLen options) + toggleButtonSetActive confirmExitCheckButton $ confirmExit options + toggleButtonSetActive showMenuCheckButton $ showMenu options + toggleButtonSetActive boldIsBrightCheckButton $ boldIsBright options + toggleButtonSetActive enableSixelCheckButton $ enableSixel options + toggleButtonSetActive allowBoldCheckButton $ allowBold options + entryBufferSetText wordCharExceptionsEntryBuffer (wordCharExceptions options) (-1) + + -- Run dialog then close + res <- dialogRun preferencesDialog + + -- When closing the dialog get the new settings + when (toEnum (fromIntegral res) == ResponseTypeAccept) $ do + maybeFontDesc <- fontChooserGetFontDesc fontButton + maybeFontConfig <- + join <$> mapM fontConfigFromFontDescription maybeFontDesc + maybeShowScrollbar <- + comboBoxGetActive showScrollbarComboBoxText [ShowScrollbarNever ..] + maybeShowTabBar <- + comboBoxGetActive showTabBarComboBoxText [ShowTabBarNever ..] + maybeCursorBlinkMode <- + comboBoxGetActive cursorBlinkModeComboBoxText [CursorBlinkModeSystem ..] + scrollbackLenVal <- + fromIntegral <$> spinButtonGetValueAsInt scrollbackLenSpinButton + confirmExitVal <- toggleButtonGetActive confirmExitCheckButton + showMenuVal <- toggleButtonGetActive showMenuCheckButton + boldIsBrightVal <- toggleButtonGetActive boldIsBrightCheckButton + enableSixelVal <- toggleButtonGetActive enableSixelCheckButton + allowBoldVal <- toggleButtonGetActive allowBoldCheckButton + wordCharExceptionsVal <- entryBufferGetText wordCharExceptionsEntryBuffer + + -- Apply the changes to mvarTMState + modifyMVar_ mvarTMState $ pure + . over lensTMStateFontDesc (`fromMaybe` maybeFontDesc) + . over (lensTMStateConfig . lensOptions) + ( set lensConfirmExit confirmExitVal + . set lensShowMenu showMenuVal + . set lensBoldIsBright boldIsBrightVal + . set lensEnableSixel enableSixelVal + . set lensAllowBold allowBoldVal + . set lensWordCharExceptions wordCharExceptionsVal + . over lensFontConfig (`fromMaybe` maybeFontConfig) + . set lensScrollbackLen scrollbackLenVal + . over lensShowScrollbar (`fromMaybe` maybeShowScrollbar) + . over lensShowTabBar (`fromMaybe` maybeShowTabBar) + . over lensCursorBlinkMode (`fromMaybe` maybeCursorBlinkMode) + ) + + -- Save the changes to the preferences files + withMVar mvarTMState $ saveToPreferencesFile . view lensTMStateConfig + + -- Update the app with new settings + applyNewPreferences mvarTMState + + widgetDestroy preferencesDialog +