From f85cf3019b9da5717898903da7754f40c26b9f16 Mon Sep 17 00:00:00 2001 From: "(cdep)illabout" Date: Sat, 21 Oct 2023 21:43:59 +0900 Subject: [PATCH 1/5] Add a New Window menu entry to the File menu --- src/Termonad/App.hs | 7 +++++++ src/Termonad/XML.hs | 4 ++++ 2 files changed, 11 insertions(+) diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs index faa150f..fbb3408 100644 --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -444,6 +444,13 @@ setupTermonad tmConfig app win builder = do tmNote' <- getTMNotebookFromTMState mvarTMState tmWinId relabelTabs tmNote' + newWindowAction <- simpleActionNew "newwin" Nothing + void $ onSimpleActionActivate newWindowAction $ \_ -> + pure () + -- void $ createTerm handleKeyPress mvarTMState tmWinId + actionMapAddAction app newWindowAction + applicationSetAccelsForAction app "app.newwin" ["N"] + newTabAction <- simpleActionNew "newtab" Nothing void $ onSimpleActionActivate newTabAction $ \_ -> void $ createTerm handleKeyPress mvarTMState tmWinId diff --git a/src/Termonad/XML.hs b/src/Termonad/XML.hs index b948132..baf27e2 100644 --- a/src/Termonad/XML.hs +++ b/src/Termonad/XML.hs @@ -56,6 +56,10 @@ menuDoc = File
+ + _New Window + app.newwin + New _Tab win.newtab From af3349e2890f0d57d3fc1068713f7416c2e38d2a Mon Sep 17 00:00:00 2001 From: "(cdep)illabout" Date: Sat, 21 Oct 2023 21:44:25 +0900 Subject: [PATCH 2/5] Rename Termonad.PreferencesFile to Termonad.Preferences.File. This commit also adds the beginning of a Termonad.Preferences module, which will re-export everything generally useful from the Termonad.Preferences.File module. --- src/Termonad/App.hs | 2 +- src/Termonad/Config.hs | 2 +- src/Termonad/Preferences.hs | 9 +++++++++ src/Termonad/{PreferencesFile.hs => Preferences/File.hs} | 3 ++- termonad.cabal | 3 ++- 5 files changed, 15 insertions(+), 4 deletions(-) create mode 100644 src/Termonad/Preferences.hs rename src/Termonad/{PreferencesFile.hs => Preferences/File.hs} (99%) diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs index fbb3408..cafface 100644 --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -153,7 +153,7 @@ import Termonad.Lenses , lensTerm , lensWordCharExceptions, lensTMStateWindows, lensTMWindowNotebook ) -import Termonad.PreferencesFile (saveToPreferencesFile) +import Termonad.Preferences (saveToPreferencesFile) import Termonad.Term ( createTerm , relabelTabs diff --git a/src/Termonad/Config.hs b/src/Termonad/Config.hs index e613fa5..38ca175 100644 --- a/src/Termonad/Config.hs +++ b/src/Termonad/Config.hs @@ -61,5 +61,5 @@ module Termonad.Config import GI.Vte (CursorBlinkMode(..)) -import Termonad.PreferencesFile (tmConfigFromPreferencesFile) +import Termonad.Preferences (tmConfigFromPreferencesFile) import Termonad.Types diff --git a/src/Termonad/Preferences.hs b/src/Termonad/Preferences.hs new file mode 100644 index 0000000..bf63397 --- /dev/null +++ b/src/Termonad/Preferences.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE CPP #-} + +module Termonad.Preferences + ( module Termonad.Preferences.File + ) where + +import Termonad.Prelude + +import Termonad.Preferences.File (saveToPreferencesFile, tmConfigFromPreferencesFile) diff --git a/src/Termonad/PreferencesFile.hs b/src/Termonad/Preferences/File.hs similarity index 99% rename from src/Termonad/PreferencesFile.hs rename to src/Termonad/Preferences/File.hs index b420662..658693c 100644 --- a/src/Termonad/PreferencesFile.hs +++ b/src/Termonad/Preferences/File.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -module Termonad.PreferencesFile where +module Termonad.Preferences.File where import Termonad.Prelude @@ -193,3 +193,4 @@ saveToPreferencesFile :: TMConfig -> IO () saveToPreferencesFile TMConfig { options = options } = do confFile <- getPreferencesFile writePreferencesFile confFile options + diff --git a/termonad.cabal b/termonad.cabal index ffd175f..ec012f7 100644 --- a/termonad.cabal +++ b/termonad.cabal @@ -68,7 +68,8 @@ library , Termonad.Keys , Termonad.Lenses , Termonad.Pcre - , Termonad.PreferencesFile + , Termonad.Preferences + , Termonad.Preferences.File , Termonad.Prelude , Termonad.Term , Termonad.Types From b21b3364ca16010a0cb656a70b70b64d794a258a Mon Sep 17 00:00:00 2001 From: "(cdep)illabout" Date: Sat, 21 Oct 2023 21:46:53 +0900 Subject: [PATCH 3/5] Add CHANGELOG.md add Termonad.Preferences module. --- CHANGELOG.md | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 573ed0b..9af1e9c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,15 @@ funtionality, you should be able to use the `Termonad.start` function (in place of `Termonad.defaultMain`). +* Rename the `Termonad.PreferencesFile` module to `Termonad.Preferences.File`. + + Also, add a `Termonad.Preferences` module that re-exports everything helpful + from the `Termonad.Preferences.File` module. Also, some of the + preferences-related functionality from `Termonad.App` has been moved into + `Termonad.Preferences`. + [#238](https://github.com/cdepillabout/termonad/pull/238) + + ## 4.5.0.0 * Add an `allowBold` option (which defaults to `True`). This can be used if From 2c900eb4262f659b17964a16f7f237d6acaa823c Mon Sep 17 00:00:00 2001 From: "(cdep)illabout" Date: Sun, 22 Oct 2023 09:15:08 +0900 Subject: [PATCH 4/5] Move preferences-dialog-related operations from Termonad.App to Termonad.Preferences Termonad.Preferences also re-exports helpful funtions from Termonad.Preferences.File. --- src/Termonad/App.hs | 288 ++--------------------------------- src/Termonad/Preferences.hs | 290 ++++++++++++++++++++++++++++++++++++ src/Termonad/Types.hs | 19 ++- 3 files changed, 318 insertions(+), 279 deletions(-) diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs index cafface..1f8ba91 100644 --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -8,7 +8,6 @@ import Config.Dyre (wrapMain, newParams) import Control.Lens ((^.), (^..), over, set, view, ix) import Data.FileEmbed (embedFile) import Data.FocusList (focusList, moveFromToFL, updateFocusFL) -import qualified Data.List as List import Data.Sequence (findIndexR) import qualified Data.Text as Text import Data.Text.Encoding (encodeUtf8) @@ -28,20 +27,11 @@ import GI.Gtk ( Application , ApplicationWindow(ApplicationWindow) , Box(Box) - , CheckButton(CheckButton) - , ComboBoxText(ComboBoxText) - , Dialog(Dialog) - , Entry(Entry) - , FontButton(FontButton) - , Label(Label) - , PolicyType(PolicyTypeAutomatic) , PositionType(PositionTypeRight) - , ResponseType(ResponseTypeAccept, ResponseTypeNo, ResponseTypeYes) + , ResponseType(ResponseTypeNo, ResponseTypeYes) , ScrolledWindow(ScrolledWindow) - , SpinButton(SpinButton) , pattern STYLE_PROVIDER_PRIORITY_APPLICATION , aboutDialogNew - , adjustmentNew , applicationAddWindow , applicationGetActiveWindow , applicationSetAccelsForAction @@ -50,9 +40,6 @@ import GI.Gtk , boxPackStart , builderNewFromString , builderSetApplication - , comboBoxGetActiveId - , comboBoxSetActiveId - , comboBoxTextAppend , containerAdd , cssProviderLoadFromData , cssProviderNew @@ -61,13 +48,8 @@ import GI.Gtk , dialogNew , dialogResponse , dialogRun - , entryBufferGetText - , entryBufferSetText , entryGetText , entryNew - , fontChooserSetFontDesc - , fontChooserGetFontDesc - , getEntryBuffer , gridAttachNextTo , gridNew , labelNew @@ -79,18 +61,11 @@ import GI.Gtk , onNotebookPageReordered , onNotebookSwitchPage , onWidgetDeleteEvent - , scrolledWindowSetPolicy , setWidgetMargin - , spinButtonGetValueAsInt - , spinButtonSetAdjustment - , spinButtonSetValue , styleContextAddProviderForScreen - , toggleButtonGetActive - , toggleButtonSetActive , widgetDestroy , widgetGrabFocus , widgetSetCanFocus - , widgetSetVisible , widgetShow , widgetShowAll , windowPresent @@ -102,17 +77,13 @@ import qualified GI.Gtk as Gtk import GI.Pango ( FontDescription , pattern SCALE - , fontDescriptionGetFamily - , fontDescriptionGetSize - , fontDescriptionGetSizeIsAbsolute , fontDescriptionNew , fontDescriptionSetFamily , fontDescriptionSetSize , fontDescriptionSetAbsoluteSize ) import GI.Vte - ( CursorBlinkMode(..) - , catchRegexError + ( catchRegexError , regexNewForSearch , terminalCopyClipboard , terminalPasteClipboard @@ -120,40 +91,26 @@ import GI.Vte , terminalSearchFindPrevious , terminalSearchSetRegex , terminalSearchSetWrapAround - , terminalSetBoldIsBright - , terminalSetCursorBlinkMode , terminalSetFont - , terminalSetScrollbackLines - , terminalSetWordCharExceptions - , terminalSetAllowBold ) -import System.Environment (getExecutablePath) -import System.FilePath (takeFileName) import System.IO.Error (doesNotExistErrorType, ioeGetErrorType, ioeGetFileName, tryIOError) -import Termonad.Gtk (appNew, imgToPixbuf, objFromBuildUnsafe, terminalSetEnableSixelIfExists) +import Termonad.Cli (parseCliArgs, applyCliArgs) +import Termonad.Gtk (appNew, imgToPixbuf, objFromBuildUnsafe) import Termonad.Keys (handleKeyPress) import Termonad.Lenses - ( lensBoldIsBright - , lensEnableSixel - , lensAllowBold - , lensConfirmExit - , lensCursorBlinkMode + ( lensConfirmExit , lensFontConfig , lensOptions , lensShowMenu - , lensShowScrollbar - , lensShowTabBar - , lensScrollbackLen - , lensTMNotebookTabTermContainer , lensTMNotebookTabs , lensTMNotebookTabTerm , lensTMStateApp , lensTMStateConfig , lensTMStateFontDesc , lensTerm - , lensWordCharExceptions, lensTMStateWindows, lensTMWindowNotebook + , lensTMStateWindows, lensTMWindowNotebook ) -import Termonad.Preferences (saveToPreferencesFile) +import Termonad.Preferences (showPreferencesDialog) import Termonad.Term ( createTerm , relabelTabs @@ -161,36 +118,26 @@ import Termonad.Term , termPrevPage , termExitFocused , setShowTabs - , showScrollbarToPolicy ) import Termonad.Types - ( ConfigOptions(..) - , FontConfig(..) + ( FontConfig(..) , FontSize(FontSizePoints, FontSizeUnits) - , ShowScrollbar(..) - , ShowTabBar(..) , TMConfig , TMNotebookTab , TMState , TMState' , TMWindowId + , fontSizeFromFontDescription , getFocusedTermFromState , getTMNotebookFromTMState , getTMNotebookFromTMState' - , getTMWindowFromTMState' , modFontSize , newEmptyTMState - , tmNotebook , tmNotebookTabTermContainer , tmNotebookTabs , tmStateApp - , tmStateWindows - , tmWindowAppWin - , tmWindowNotebook ) -import Termonad.XML (interfaceText, menuText, preferencesText) -import Termonad.Cli (parseCliArgs, applyCliArgs) -import Termonad.IdMap (keysIdMap) +import Termonad.XML (interfaceText, menuText) setupScreenStyle :: IO () setupScreenStyle = do @@ -276,22 +223,6 @@ modifyFontSizeForAllTerms modFontSizeFunc mvarTMState tmWinId = do lensTerm foldMap (\vteTerm -> terminalSetFont vteTerm (Just fontDesc)) terms -fontSizeFromFontDescription :: FontDescription -> IO FontSize -fontSizeFromFontDescription fontDesc = do - currSize <- fontDescriptionGetSize fontDesc - currAbsolute <- fontDescriptionGetSizeIsAbsolute fontDesc - return $ if currAbsolute - then FontSizeUnits $ fromIntegral currSize / fromIntegral SCALE - else - let fontRatio :: Double = fromIntegral currSize / fromIntegral SCALE - in FontSizePoints $ round fontRatio - -fontConfigFromFontDescription :: FontDescription -> IO (Maybe FontConfig) -fontConfigFromFontDescription fontDescription = do - fontSize <- fontSizeFromFontDescription fontDescription - maybeFontFamily <- fontDescriptionGetFamily fontDescription - return $ (`FontConfig` fontSize) <$> maybeFontFamily - compareScrolledWinAndTab :: ScrolledWindow -> TMNotebookTab -> Bool compareScrolledWinAndTab scrollWin flTab = let ScrolledWindow managedPtrFLTab = tmNotebookTabTermContainer flTab @@ -701,205 +632,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..f7a113b 100644 --- a/src/Termonad/Preferences.hs +++ b/src/Termonad/Preferences.hs @@ -2,8 +2,298 @@ 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 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 + diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index 31f0172..90eaf2b 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -26,7 +26,7 @@ import GI.Gtk , notebookGetNthPage , notebookGetNPages ) -import GI.Pango (FontDescription) +import GI.Pango (FontDescription, fontDescriptionGetSize, fontDescriptionGetSizeIsAbsolute, pattern SCALE, fontDescriptionGetFamily) import GI.Vte (Terminal, CursorBlinkMode(..)) import Termonad.Gtk (widgetEq) import Termonad.IdMap (IdMap, IdMapKey, singletonIdMap, lookupIdMap) @@ -332,6 +332,17 @@ modFontSize i (FontSizeUnits oldUnits) = let newUnits = oldUnits + fromIntegral i in FontSizeUnits $ if newUnits < 1 then oldUnits else newUnits +fontSizeFromFontDescription :: FontDescription -> IO FontSize +fontSizeFromFontDescription fontDesc = do + currSize <- fontDescriptionGetSize fontDesc + currAbsolute <- fontDescriptionGetSizeIsAbsolute fontDesc + pure $ + if currAbsolute + then FontSizeUnits $ fromIntegral currSize / fromIntegral SCALE + else + let fontRatio :: Double = fromIntegral currSize / fromIntegral SCALE + in FontSizePoints $ round fontRatio + -- | Settings for the font to be used in Termonad. data FontConfig = FontConfig { fontFamily :: !Text @@ -351,6 +362,12 @@ defaultFontConfig = , fontSize = defaultFontSize } +fontConfigFromFontDescription :: FontDescription -> IO (Maybe FontConfig) +fontConfigFromFontDescription fontDescription = do + fontSize <- fontSizeFromFontDescription fontDescription + maybeFontFamily <- fontDescriptionGetFamily fontDescription + return $ (`FontConfig` fontSize) <$> maybeFontFamily + -- | This data type represents an option that can either be 'Set' or 'Unset'. -- -- This data type is used in situations where leaving an option unset results From 8466908f64cd93f1a0221c09c79cc5350b6786ea Mon Sep 17 00:00:00 2001 From: "(cdep)illabout" Date: Mon, 23 Oct 2023 13:31:06 +0900 Subject: [PATCH 5/5] Add more haddocks --- src/Termonad/Preferences.hs | 18 +++++++++++++++++- src/Termonad/Preferences/File.hs | 13 +++++++++++++ 2 files changed, 30 insertions(+), 1 deletion(-) diff --git a/src/Termonad/Preferences.hs b/src/Termonad/Preferences.hs index f7a113b..0b10e24 100644 --- a/src/Termonad/Preferences.hs +++ b/src/Termonad/Preferences.hs @@ -1,5 +1,16 @@ {-# 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 @@ -160,6 +171,12 @@ applyNewPreferencesToWindow mvarTMState tmWinId = do -- Sets the remaining preferences to each tab foldMap (applyNewPreferencesToTab mvarTMState) 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 mvarTMState = do tmState <- readMVar mvarTMState @@ -296,4 +313,3 @@ showPreferencesDialog mvarTMState = do applyNewPreferences mvarTMState widgetDestroy preferencesDialog - diff --git a/src/Termonad/Preferences/File.hs b/src/Termonad/Preferences/File.hs index 658693c..0724787 100644 --- a/src/Termonad/Preferences/File.hs +++ b/src/Termonad/Preferences/File.hs @@ -1,5 +1,18 @@ {-# LANGUAGE CPP #-} +-- | Description : Read and write to the Preferences file +-- Copyright : (c) Dennis Gosnell, 2023 +-- License : BSD3 +-- Stability : experimental +-- Portability : POSIX +-- +-- This module contains functions for reading and writing to the preferences file. +-- +-- The preferences file is generally stored in +-- @~/.config/termonad/termonad.yaml@. It stores run-time preferences that +-- have been set through the Preferences dialog. Preferences are loaded on +-- app startup, but only if the @termonad.hs@ configuration file doesn't exist. + module Termonad.Preferences.File where import Termonad.Prelude